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ABSTRACT 

A  software  metric  is  a  tool  that  should  be  used  in  the  development  of  quality 
software.  The  properties  that  define  good  software  vary  but  encompass  reliability, 
complexity,  efficiency,  testability,  understandability,  and  modifiability.  The 
Henry  metric  measures  the  complexity  of  data  flow  within  a  module  and  the 
complexity  of  inter-module  communication.  This  thesis  is  an  extension  of  a 
previous  thesis  titled  AdaMeasure'  that  calculated  the  Halstead  metric.  The 
present  design  and  implementation  is  a  tool  that  computes  the  Halstead  and 
Henry  metrics  for  Ada  programs. 
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I.  INTRODUCTION  AND  BACKGROUND 

A.  DEFINITIONS 

A  metric  is  an  assignment  of  indices  of  merit  to  programs  in  order  to  evaluate 
and  predict  software  quality  [Ref.l:  p. 6-2].  The  qualities  to  measure  are,  at 
present,  subjectively  chosen  but  in  general  encompass  reliability,  complexity, 
efficiency,  testability,  understandability  and  modifiablity  [Ref.2:  p. 1-3].  The 
predictive  nature  of  a  metric  allows  it  to  be  used  to  say  "when"  to  proceed  to  the 
next  phase  in  the  software  life  cycle  model.  Another  aspect  of  the  predictive 
nature  of  a  metric  would  be  for  it  to  provide  management  with  a  rough  guess  of 
the  outcome  of  a  particular  path  of  development,  provide  an  acceptance  index,  or 
provide  an  immediate  feedback  loop  to  the  implementors  while  in  the  unit  test 
phase  [Ref.2:  p. 5].  How  the  metric  is  implemented  will  dictate  its  primary  use 
from  the  above  selections. 

B.  SALLIE  HENRY'S  METRIC 

Sallie  Henry's  metric  attempts  to  measures  data  flow  complexity.  It  is 
intended  to  be  used  as  a  tool  to  establish  a  module's  quality  or  to  enforce 
particular  modularization  standards  [Ref.2:  p. 6].  She  argues  that  quality  control 
of  software  is  the  result  of  software  reliability  and  that  reliability  comes  about 
through  well  designed  modules  that  do  not  have  complex  data  flow. 


The  hierarchical  structure  of  a  program  should  be  layered  modules.  Each 
layer  should  function  as  a  virtual  machine  and  be  composed  of  modules.  This 
approach  to  modularization  gives  each  module  characteristics  that  can  be 
exploited  so  that  each  module  can  be  independently  developed,  more  easily 
comprehended,  assembled  so  that  the  system  is  more  stable  and  designed  so  that 
the  system  is  a  great  deal  more  flexible.  This  schema  of  development  extols  two 
primary  tenets  that  are  stated  by  D.  Parnas  in  [Ref.3:  p. 339]  and  quoted  here: 

.  .  .  provide  the  user  of  a  module  with  all  the  information  to  use  the  module 
correctly,  and  nothing  more.  Provide  the  implementor  of  the  module  with  all  the 
information  to  implement  the  module  correctly,  and  nothing  more. 

All  this  implies  that  a  good  design  will  have  high  module  cohesion,  good 
module  strength  and  low  module  coupling  [Ref.4:  p. 330]. 

C.    INFORMATION  FLOW 

Information  flow  complexity  is  a  twofold  process  the  flow  of  data  within  a 
module  and  the  flow  of  data  external  to  the  module.  The  measurement  of  these 
criteria  is  dependent  on  two  premises:  (1)  that  there  is  a  capability  to  measure 
this  data  and  (2)  the  data  obtained  can  be  used  to  evaluate  software  design.  The 
seemingly  obvious  nature  of  the  first  premise  runs  into  problems  in 
implementation  and  applicability,  but  if  it  is  accepted  that  the  first  deficiency  can 
be  surmounted,  then  the  second  part  remains  to  be  shown  as  reasonable. 
Applicability  is  a  debated  concept  that  is  still  not  resolved.  It  revolves  around 
whether  the  data  gathered  is  related  to  the  property  under  consideration.    It  is 


further  exacerbated  by  the  human  element  that  defines  an  environmental  bubble 
and  then  programs  within  this  bubble.  How  to  measure  this  bubble  without 
destroying  its  foundations  is  the  problem  of  measuring  human  performance.  The 
problem  of  what  to  measure  is  the  problem  of  applicability. 

The  more  specific  the  metric's  application  the  less  the  applicability  property  is 
questioned,  but,  the  problem  of  "what"  to  measure  is  still  not  clearly  defined. 
This  thesis  will  not  argue  the  applicability  question  because  the  approach  of  Sallie 
Henr>'  is  reasonable  and  the  results  obtained  from  the  metric  appear  to  adequately 
encompass  the  area  of  data  flow  complexity.  If  the  reader  will  accept  that  the 
properties  measured  are  related  to  data  flow  complexity  then  the  results  obtained 
are  also  related  to  complexity. 

The  second  premise  is  even  more  thorny.  If  the  data  is  obtained  and  it  seems 
reasonable  can  it  be  shown  to  be  truly  the  result  of  the  property  under 
measurement?  Any  human  endeavor  will  never  be  clearly  and  objectively 
quantified.  Thus,  the  answer  to  the  efficacy  of  the  second  premise  is,  proceed  and 
maybe  the  amassing  of  results  will  eventually  show  the  correlation. 

The  above  analysis  is  far  from  a  convincing  argument  to  utilize  metrics  to 
measure  programs  however  as  this  thesis  was  developed  the  applicability  of 
measuring  data  flow  complexity  in  order  to  determine  code  quality  became  more 
apparent  although  not  proven.  Nothing  will  be  learned  if  no  attempt  is  made  to 
measure    data    flow    complexity.     This    thesis    attempts    to    measure    data     flow 
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complexity  in  the  light  of  learning  and  the  hope  that  the  data  gathered  will  prove 
the  applicability  of  the  process. 

Consider  first  a  simple  module:  a  procedure  in  a  structured  language.  Each 
procedure  defines  certain  relations  between  itself  and  other  procedures.  These 
include: 

-  formal  input/output  parameters 

-  function  call  input  and  return  data 

-  local  data  structures 

-  global  data  structures 

These  relations  will  generate  a  particular  information  flow  structure  similar  to 
a  hierarchical  tree  structure.  This  tree  structure  is  peculiar  to  the  procedure  and 
will  reflect  its  complexity  of  structure.  It  is  reasonable  to  analyze  this  tree  to 
determine  derived  calls,  local  data  flow  and  global  data  flow. 

D.    RELATIONS 

Some  definitions  are  now  in  order.  Global  data  flow  exists  from  procedure  1 
to  procedure  2  if  procedure  1  deposits  data  in  the  global  data  structure  and  then 
procedure  2  reads  that  data.  Local  data  flow  comprises  direct  and  indirect  species. 
A  local  direct  flow,  from  procedure  1  to  procedure  2,  results  when  procedure  1 
calls  2  passing  parameters.  An  indirect  data  exchange  from  procedure  1  to 
procedure  2  exists  if  procedure  2  calls  1,  which  returns  a  value  used  by  2,  or 
procedure  3  calls  both  1  and  2,  and  passes  an  output  value  from  1  to  2. 
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Figure  1  represents  data  flow  from  procedure  to  procedure  or  from  a 
procedure  into  a  data  structure.  Parameter  passing  within  this  scheme  is 
represented  by  the  arrows.  A  hidden  data  exchange  through  modification  of  a 
variable  is  represented  by  the  dashed  flow  arrow.  Module  A  retrieves  data  from 
the  data  structure  then  calls  B  passing  a  parameter;  module  B  updates  the  data 
structure.  C  calls  D  passing  a  parameter.  D  calls  E  with  a  parameter  and  E 
returns  a  value  to  D  which  is  used  by  D  and  passed  to  F.  The  function  of  F 
updates  the  data  structure. 


Figure  1.  Data  Flow  Structure 
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The  direct  data  flows  represented  are: 
A->  B,  C  ->  D,  D  ->  E,  D  ->  F. 

These  are  simply  the  calls. 

The  indirect  local  flows  are: 
E->  D,  F  ->  A. 

The  global  flows  are: 
B->  A,  F->  A. 

Both  B  and  F  update  the  data  structure  while  A  retrieves  data  from  the 
structure. 

The  implications  of  data  flow  for  procedure  and  function  calls  will  be 
discussed  later  with  derived  calls. 

The  calling  notation  A(x)  ->  B()  or  A()  ->  B(x)  is  used  to  connote  a  data 
flow  transmission  from  A  to  B  either  by  direct  parameter  passing  or  side-efFect.  In 
the  first  condition  the  variable  x  is  returned  to  procedure  A  and  in  the  second 
example  the  variable  x  is  sent  to  B.  A  condition  that  leads  the  Henr>'  metric  to 
not  detect  a  procedure  or  function  call's  data  flow  (labeled  a  missed  call)  is  for  the 
condition  where  A(x)  ->  B()  and  variable  x  is  a  returned  value  from  B  not 
modified  within  procedure  A's  code.  An  example  of  this  would  be  a  conditional 
statenaent  within  A  that  depends  on  the  returned  value  from  function  B.  The 
data  flow  detection  problem  leads  to  two  key  ideas,  efl"ective  parameters  and  data 
utilization. 

Calls  that  are  detected  by  information  flow  analysis  are  dependent  upon  how 
the  information  is  passed.    If  the  conditions  A()  ->  B(x)  exists  where  parameter  x 

11 


is  passed  to  B  or  condition  A()  ->  B()  where  no  parameters  are  exchanged  then 
the  calls  will  not  be  missed  if  B  receives  information  in  one  of  the  following 
formats: 

-  a  formal  parameter 

-  a  data  structure 

-  a  constant 

-  an  actual  parameter  from  a  third  procedure  whose  value  is 

modified  within  A  prior  to  the  call  to  B 

An  effective  parameter  will  define  the  call  structure  in  such  a  way  that  the 
data  flow  will  not  be  missed.  It  is  a  parameter  that  receives  information  from  one 
of  the  calling  procedure's  parameters,  a  data  structure,  a  constant,  or  a  third 
procedure's  returned  actual  parameter  that  is  modified  within  the  calling  modules 
structure.  What  the  eff"ective  parameter  implies  is  that  side-  eff'ect  data  flow  is 
difficult  to  effectively  analyze.  Another  construct  that  will  cause  a  missed  call  is 
the  condition  A(z)  ->  B(x)  where  B  is  a  function.  This  condition  means  A  uses 
data  from  B.  A  uses  data  from  B  if  (1)  B  updates  a  data  structure  used  by  A;  (2) 
A  receives  a  constant  from  B;  (3)  A  receives  an  output  parameter  from  B;  or  (4)  B 
updates  a  return  value  to  A.  Thus  information  flow  will  be  detected  if  A  passes  B 
an  effective  parameter  or  if  A  uses  data  from  B. 

Appendix  A  gives  all  the  rules  that  are  applicable  to  the  data  flow 
relationships.  Some  notation  is  now  needed  to  simplify  the  descriptions  that 
follow. 
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The  form  of  a  relation  is  L  <-  Rl,  R2,  R3,...Rn;  where  L  is  the  resultant  from 
the  application    of  the  relationships  Rl,  R2,  ...  Rn.    An  example  would  be: 
A.D3  <-  A.Dl,  A.D2,  A. constant. 

This  series  notation  represents  the  code  line  that  begins  with  D3  below. 

A() 
begin 


D3  :=  Dl  +  D2  +  1; 

end  procedure  A; 


In  words,  the  A.D3  means  procedure  A  updates  data  structure  D3  by  first 
applying  relationship  A.Dl  then  A.D2  and  finally  A. constant.  This  format  shows 
that  data  flows  into  procedure  A's  data  structure  D3  from  the  noted  relationships. 
A  thorough  discussion  of  the  notation  for  the  relations  is  given  in  Appendix  A  but 
a  short  discussion  follows  to  aide  in  the  immediate  understanding  of  Figure  2. 

The  notation  B.I.I  defines  the  first  input  parameter  in  the  actual  parameter 
list  of  procedure  B  and  an  O  would  refer  to  an  output  parameter.  All  possible 
data  flow  paths  are  considered  even  if  a  B.I.I  parameter  is  not  an  input 
parameter.  Thus,  if  procedure  B  has  an  output  actual  parameter  in  position  B.l 
and  the  Henry  metric  attempts  to  analyze  this  parameter  as  an  input  flow  an 
error  condition  would  result  from  the  attempted  evaluation  (depicted  as 
B. ERR  OR).  B.NULL  means  that  no  relationship  exits  for  this  parameter  or  that 
there  is  no  data  flow  into  or  out  of  the  parameter  being  considered. 
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Figure  2.  Data  Flow  With  Call  Structure 


Code 

A() 
begin 

X  :=  Dl  +  1; 

Y  :=  D2; 

B(X,Y); 
end; 


B(P,Q) 
begin 

D3  :=P  +  Q; 
end; 
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Relations  Set 

Al  B.I.I  <-  A.Dl,  A. CONSTANT 
A2  B.2.I  <-  A.D2 
Bl  B.1.0  <-  B.NULL 
B2  B.2.0  <-  B.NULL 
B3  B.D3    <-  B.I.I,  B.2.I 


The  relation  sets  were  derived  by  looking  at  the  data  flow  into  and  out  of 
procedure  A.  That  is,  since  procedure  A  has  no  parameters  there  can  only  be 
local  data  flows  into  or  out  of  the  procedure.  These  flows  are  described  in  terms 
of  the  procedure  call  to  B.  B.I.I  stands  for  procedure  B's  first  input  parameter. 
This  parameter  is  fed  from  procedure  A's  data  structure  Dl  and  a  constant. 
Analyzing  procedure  B's  second  input  parameter  yields  the  A2  relationship. 
Relationship  Bl  describes  the  first  parameter  in  procedure  B  as  an  output 
parameter  to  procedure  A  that  receives  no  data  for  transfer.  Relationship  B3 
describes  how  the  two  input  parameters  to  procedure  B  constitute  the  data  flow 
to  this  data  structure. 

The  data  flow  analysis  deals  primarily  with  the  analysis  of  parameters  which 
are  direct  data  flow  and  indirect  data  flow  as  defined  above.  Modifying  Figure  2 
and  incorporating  some  local  variables  will  illustrate  some  more  data  flow  analysis 
techniques  as  seen  in  Figure  3. 
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Figure  3.  Data  Flow  And  Inter-dependent  Procedures 


Code 

AQ 
begin 

X  :=  Dl  +  1; 

Y  :=  D2; 

B(X,Y) 
end; 


B(P,Q) 
begin 

R:=Q; 

C(P,R,S); 
D3  :=  S; 
end; 


C(I,J,K) 
begin 

K:=I  + J; 

J  :=  J  +  1; 
end; 
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Relation  Set 

Al,  A2  same. 

Bl  B.1.0  <-  C.l.O 

B2  B.2.0  <-  B.NULL 

B3  C.I.I  <-  B.I.I 

B4  C.2.I  <-  B.2.I 

B5  C.3.I  <-  B. ERROR 

B6  B.D3    <-  C.3.0 


CI    C.I.I  <-  C.NULL 

C2    C.2.0  <-  C.2.I,  C. CONSTANT 

C3    C.3.0  <-  C.I.I,  C.2.I 

In  the  relation  set  Bl  receives  data  from  procedure  C's  output  parameter.  B2 
is  the  same.  B3  through  B5  describe  the  parameter  list  of  procedure  C.  However 
B5  denotes  an  error  or  a  condition  that  is  not  allowed.  That  is,  the  data  direction 
was  in  error  as  variable  S  is  an  output  from  procedure  C  as  indicated  by  relation 
B6.  It  should  be  noted  that  this  relation  set  building  considers  all  possible  data 
flow  paths  without  regard  to  the  possibility  that  the  parameters  could  be  assigned 
only  particular  directions  as  Ada  formal  parameters  are.  Figure  4  shows  the  effects 
of  a  function  call. 

Code 

A() 
begin 
X  :=  Dl  +  1; 

Y  .-  F(X); 
B(X,Y) 
end; 
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Figure  4.  Data  Flow  With  Function  Call 


F(M)  return  integer; 

begin 

N  :=  D2  *  M; 

return  N; 
end; 


Relation  Sets  are  changed  as  follows: 

Al   F.I.I  <- A.Dl,  A. CONSTANT 

A2   B.I.I  <-  A.Dl,  A. CONSTANT,  F.l.O 

A3   B.2.I  <-  F.O 

Fl   F.l.O  <-  F.NULL 
F2   F.O     <-  F.D2,  F.I.I 

Relation  Al  has  changed  to  reflect  the  analysis  of  the  function  call  to  F.  The 
input  to  the  function  call  is  analyzed  as  well  as  its  output  and  any  possible 
modification  of  its  input  parameter.  This  analysis  can  be  seen  to  cover  all 
possibilities  of  hidden  data  transfers  except  the  missed  calls  described  earlier. 
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E.  INFORMATION  FLOW  STRUCTURE 

Once  the  relation  set  has  been  built  the  relations  are  sorted  alphabetically  and 
stored  for  future  use  in  the  Information  Flow  Structure  (IFS).  A  recursive 
algorithm  is  employed  to  build  the  information  tree  structure  for  the  flow 
analysis.  The  IFS  is  then  analyzed  to  find  the  derived  calls,  the  local  flows  and, 
finally,  the  global  flows. 

The  IFS  will  have  leaves  that  are  data  structures;  the  root  is  the  initial  call 
from  the  highest  level  procedure.  Each  node  of  the  tree  will  have  the  relational 
form  of  X.DS,  X.O,  X.k.I,  or  X.k.O.  See  Appendix  A  for  all  the  possibilities  of 
derived  calls.  The  local  flows  are  described  in  Appendix  A  as  derived  calls.  The 
global  flows  for  a  particular  data  structure  are  all  the  possible  paths  from  leaf 
elements  of  the  form  A.DS  to  the  root. 

F.  INDICES  OF  MERIT 

The  calculations  of  the  indices  of  merit  use  the  idea  that  the  complexity  of  a 
module  comprises  the  complexity  of  the  code  plus  the  complexity  of  the 
connections  of  the  code  to  other  modules.  The  formula  describing  the  complexity 
of  a  module  is 

Complexity  =  length  *  (fan-in  *  fan-out)  ^  *code_index. 

Length  is  defined  as  the  number  of  executable  statements.  The  expression 
fan-in  *  fan-out  represents  all  the  combinatorial  possibilities  for  each  input  to 
produce   an   output.     The  code   index   is   an   exponent   that   represents  the  code 
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difficulty.  Nominal  code  difficulty  for  operating  systems  is  2.    This  index  needs 
more  data  for  other  types  of  programming. 

The  purpose  of  this  computation  is  to  produce  comparative  numbers  of  merit 
that  point  out  and  isolate  specific  areas  within  the  code  that  have  the  potential 
for  problems.  A  high  fan-in/fan-out  implies  a  large  interconnection  to  outside 
modules.  This  leads  to  the  assessment  that  the  code  in  question  is  most  likely  not 
properly  modularized  or,  more  succinctly,  that  the  code  has  more  than  one 
function.  The  other  form  of  data  flow  is  global  data  flow  to  data  structures.  It  is 
calculated  as  follows: 

Global  flow  —  write         *  (read  +  read   write)  + 

read   write  *  (read  +  read   write  -  1) 

The  term  write  refers  to  a  change  to  the  data  within  the  structure  through  an 
assignment  statement  and  a  read  is  an  access  to  the  data  structure  that  does  not 
change  the  data.  The  identifier  read-write  is  the  sum  of  reads  and  writes.  A  high 
global  flow  implies  overworked  data  structures  and  represents  a  stress  point  in  the 
program.  A  stress  point  is  the  weak  link  in  the  chain.  The  presence  of  high  flow 
is  not  automatically  an  indicator  of  poor  programming  but  it  is  a  juncture  in  the 
program  that  is  highly  susceptible  to  problems.  Once  the  metric  has  assembled  all 
the  different  components,  such  as  fan-in  or  global  reads  and  calculated  the  above 
equations  it  performs  module  analysis. 
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G.    MODULE  ANALYSIS 

Module  analysis  revolves  on  the  outputs  of  each  of  the  above  equations  and 
their  respective  components.  The  numbers  generated  are  symptomatic  of  certain 
problems.  The  analysis  is  first  conducted  with  the  equations  output  defining  the 
particular  categories  of  problems  then  the  components  refine  the  analysis. 
Examples  of  the  first  level  of  analysis  follow: 

A  high  global  flow  calculation  implies  an  overworked  data  structure.  These 
structures  are  overworked  because  of  the  need  for  continuous  accessing.  This 
implies  a  better  decentralized  design  is  in  order,  that  is,  distribute  the  information 
to  the  procedures  that  it  serves.  A  high  module  complexity  index  indicates  not 
enough  modularization.  This  number  is  to  be  treated  with  respect  but  should  be 
analyzed  in  context  with  global  data  flow.  Together  these  indices  represent  the 
in's  and  out's  of  the  modules  data.  A  corrective  action  based  solely  on  complexity 
should  be  avoided.  A  procedure  should  be  analyzed  for  singularity  of  purpose  and 
non-duplication  within  a  module.  Simply  put,  a  procedure  should  be  in  one  place, 
have  one  purpose  and  have  minimal  external  references.  These  properties  are 
quantified  by  the  Complexity  and  Global  flow  metric  numbers. 

Next  the  interim  cases  where  one  aspect  is  high  and  the  other  component  is 
low.  A  module  with  high  global  flow  and  low  complexity  shows  poor  internal 
structure.  This  structure  will  most  likely  have  excessive  numbers  of  procedures 
with  extensive  use  of  data  structures  outside  the  module.    Low  global  flow  with 
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high   module  complexity   implies   either   poor  decomposition   into   procedures   or 
extremely  complicated  interface. 

H.    INTERFACE  MEASUREMENTS 

Interface  between  procedures  comprise  protocol  interface,  coupling  and 
binding  of  procedures.  Protocol  interface  from  module  A  to  B  is  defined  as  those 
procedures  that  are  not  in  any  other  module  and  which  receive  information  from 
A  for  passing  to  B.  Binding  is  the  sensitivity  measure  between  modules,  that  is, 
tightly  bound  modules  have  a  high  sensitivity.  A  tightly  bound  module  is 
difficult  to  change  without  adversely  affecting  the  other  module.  Coupling  is  the 
strength  of  binding.  Figure  5  depicts  the  interface  structure. 


3D 


Figure  5.  Interface  Structure 
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Protocol  interface,  since  it  is  not  symmetrical  between  procedures,  requires 
the  construction  of  a  tabular  cross  reference  table  with  all  possible  procedures  on 
both  the  X  and  Y  axes.  The  internals  of  the  table  are  the  data  flow  complexity 
indexes  for  one  way  transmission  from  each  procedure  to  the  other. 

Figure  5  shows  that  binding  is  sectioned  into  five  components;  the  number  of 
procedures  sending  information  from  A  (NSP),  the  number  of  procedures 
receiving  information  from  B  (NRP),  the  number  of  procedures  in  the  protocol 
interface  (NPI),  the  number  of  paths  to  the  interface  from  A  (SPI),  and  the 
number  of  paths  from  the  interface  to  B  (PIR).  The  Direct  Flow  paths 
represented  as  the  outer  loops  are  data  transmissions  without  the  interim 
procedures.    [Ref.2:  p. 85]  lists  the  binding  calculations  as  follows: 

Binding  =  (NSP  +  NPI)  *  SPI  +  (NPI  +  NRP)  *  PIR 
The  term  (NSP  +  NPI)  *  SPI  is  the  coupling  strength. 

All  the  direct  path  binding  is  calculated  by 
DF  Binding  =  (NSP  +  NRP)  *  DF 

Modules  that  are  tightly  bound  are  extremely  difficult  to  maintain  and 
modify.  This  difficulty  stems  from  their  lack  of  independence  and  the  "ripple 
effect"  of  changes  to  one  module  flowing  into  the  other. 
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I.      THEORY  SUMMARY 

The  purpose  of  the  Henry  metric  is  to  provide  designers  and  implementors 
with  a  method  to  quantify  the  quaUty  of  the  code  that  they  are  developing.  The 
goal  is  to  produce  reliable  code  that  is  interconnected  in  as  logical  a  fashion  as 
possible.  Information  flow  complexity  produces  reliability  through  enforcement  of 
design  rules  that  lead  to  well  connected  code.  The  measurements  will  point  out 
lack  of  functionality,  improper  modularization,  poorly  designed  modules,  poorly 
designed  data  structures,  system  stress  points,  inadequate  refinement,  strength  of 
binding,  modifiability,  missing  levels  of  abstraction  and.  will  produce  comparative 
indices  to  assess  changes. 
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II.   DESIGN  CRITERIA 

A.    INTRODUCTION 

The  design  of  the  implementation  of  the  Henry  metric  was  a  two  step  process. 
First,  a  thorough  understanding  of  the  previous  work  by  Neider  and  Fairbanks 
[Ref.5:  pp.  1-164]  was  undertaken  to  determine  what  data  were  available  for 
importation  into  the  Henry  metric.  The  intention  of  the  study  and  the  basic 
design  issues  are  (1)  modify  the  output  of  the  parser  portion  of  their  thesis  to 
include  the  necessary  data  passes  to  the  Henry  metric  (2)  to  initially  analyze  only 
the  Ada  package  as  a  unit  (3)  encapsulate  as  much  of  the  Henry  metric  into  one 
Ada  package  as  possible  and  (4)  calculate  the  necessary  Henry  metric  numbers 
transparently  to  the  user  but  present  the  user  with  an  output  that  is  easily 
understood. 

The  underlying  premise,  of  this  program,  is  that  the  code  presented  for 
analysis  has  been  successfully  compiled.  If  the  code  does  not  compile  and  is 
presented  to  the  parsers  it  will  most  likely  fail  to  parse  but  in  the  event  it  does 
escape  detection  it  will  be  erroneously  analyzed. 

The  design  criteria  of  encapsulation  of  the  Henry  metric  was  modified  during 
the  implementation  due  to  the  unwieldy  length  of  the  code.  The  division  yielded 
three  packages;  one  that  holds  all  the  global  data,  another  for  the  analysis  portion 
and  a  third  for  the  interface  to  the  user.    Although  this  division  violated  one  of 
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the  basic  design  issues  it  was  necessary  in  order  to  achieve  solid  data  transfers 
between  the  Naval  Post  Graduate  School  computer  and  the  Naval  Weapons 
Station  computers. 

While  the  level  of  what  was  available  from  the  parsers  was  being  determined 
the  data  structures  of  the  Henry  metric  were  being  layed  out.  The  data  structures 
and  data  gathering  procedures  for  the  Henry  metric  were  designed  to  be  as  simple, 
yet  as  flexible  as  possible.  Once  the  layout  of  the  linked  list  data  structure  to 
hold  the  raw  information  for  the  Henry  metric  was  decided  upon,  the  tedious 
procedure  of  inserting  the  appropriate  calls  to  the  Henry  package  was  undertaken. 
Basically,  this  reduced  to  exercising  all  the  possible  data  flow  characteristics  from 
function  or  procedure  calls  that  the  Henry  metric  could  expect  to  encounter  and 
then  ensuring  that  an  appropriate  call  to  the  Henr>'  data  collection  procedure  was 
placed  in  the  Neider/Fairbanks  parser. 

Next,  the  analysis  procedure  was  designed.  The  analysis  was  separated  from 
the  display  because  computers  have  very  different  capabilities  in  their  output 
devices.  The  first  package  analyzes  the  collected  raw  data  and  the  second 
displays  the  finished,  smooth  data. 

The  program  is  menu  driven.    It  initially  gives  the  user  a  choice  to  parse  a 

new  program  or  view  old  data.    If  the  parse  choice  is  selected  the  parsers  feed 

both  the  Henry  and  the  Halstead  packages  with  data.    After  a  successful  parse  the 

user  is  presented  with  a  choice  of  either  viewing  the  Halstead  or  Henry  metric 

data.    This  is  when  the  analysis  portion  of  the  Henry  metric  is  called.    It  is  not 
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until  the  user  decides  which  data  to  view  is  there  a  distinction  made  as  to  how  to 
process  the  parsed  data.    This  feature  was  designed  for  several  reasons: 

-  Use  the  Halstead  metric  to  refine  the  code 

-  then  analyze  the  code  via  the  Henry  metric  for  data  flow 

-  but  the  user  should  still  have  the  option  to  select  either  metric 

The  data  for  both  metrics  are  essentially  different  as  are  the  purposes  for 
gathering  the  data  but  the  final  goal  of  this  dual  metric  system  is  to  produce  good 
code. 

Finally,  the  presentation  data  module  was  designed.  The  Halstead  and  the 
Henry  metric  both  produce  numbers  which  are  essentially  meaningless  unless  a 
thorough  understanding  of  the  particular  metric  implementation  is  undertaken. 
Thus,  both  metrics,  in  differing  fashions  present  "help"  data  to  aid  understanding 
of  the  metric  output.  These  files  are  both  verbally  and  graphically  presented  to 
the  user. 

The  overriding  design  issue  was  to  modularize  the  Henry  metric  as  much  as 
possible.  The  most  significant  exception  to  the  Parnas'  ideal  [Ref.4:  p. 330]  are  the 
numerous  calls  to  the  data  gathering  procedure  from  the  parser  modules.  These 
calls  depend  on  details  of  how  the  data  will  be  analyzed  in  their  sequencing  and 
data  passing  scheme.  A  conscientious  effort  was  made  to  minimize  global  data 
and  isolate  procedures  into  nearly  stand  alone  modules. 
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B.  SPECIFIC  ISSUES 

The  housekeeping  routines  of  the  global  package  are  used  to  adjust  the  parsed 
data  into  a  more  palatable  form  for  the  analysis  and  presentation  procedures. 
The  output  from  the  parser  is  stored  as  a  linked  list  of  raw  data  produced  by 
procedures  WRITE_HENRY_DATA  and  CREATENODE.  This  data  is  then 
analyzed  by  the  ANALYSIS  PACKAGE  for  the  particular  data  constructs  that 
represent  a  data  flow.  The  output  is  an  array  of  tabulated  data  that  is  a  set  of  all 
the  relations  necessary   for  the  Henry  metric  to  detect  local  and  global  data  flow. 

The  display  module  presents  data  in  a  tabular  format  or  as  a  graphical 
representation  for  relative  merit  analysis.  The  intent  was  for  the  user  to  see  the 
eflfect  of  changes,  or  to  select  a  more  verbose  description  of  the  meaning  of  the 
results.  The  modules  that  accomplish  tabular  and  graphic  displays  are  separated 
again  because  of  the  varying  capabilities  of  machines.  The  purpose  of  these 
procedures  is  to  provide  some  form  of  relative  measure  to  the  user  so  that  the 
improvement  or  results  of  a  change  could  be  more  objectively  weighed.  The 
overall  purpose  of  the  display  modules  is  to  show  the  data  in  such  a  fashion  that 
an  intelligent  assessment  is  possible. 

C.  DESIGN  ISSUES 

Design  issues  encountered  in  the  implementation  of  Henry's  metric  involve 
the  efficient  use  of  the  Ada  language's  structures  and  data  analysis  techniques. 
Sallie  Henr>'  developed  a  metric  process  in  which  the  constructs  of  a  particular 
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language  are  ignored  or  not  put  to  specific  use.  That  is,  some  languages  have 
extremely  thorough  type  and  range  checking  facilities.  This  is  not  considered  in 
the  basic  design  of  her  metric.  These  powerful  features  are  incorporated  in  Ada 
and  provide  the  application  programmer  more  analysis  capability. 

This  design  issue  concerns  the  collection  of  'all  possible  paths'  data  for 
analysis  of  actual  parameters.  The  approach  taken  by  Henry  is  biased  to  a 
language  where  input,  output,  and  combination  input  output  parameters  are 
treated  as  if  they  could  be  modified  by  the  particular  procedure  regardless  of  their 
type.  Ada  is  very  picky  about  the  manipulation  of  formal  and  actual  parameters 
and  goes  to  great  lengths  to  ensure  that  parameter  consistency  is  maintained  by 
means  of  strong  type/range  checking.  The  explicit  declaration  of  a  parameter 
type  was  used  to  select  which  component  of  the  complexity  equation  should  be 
updated.  The  appropriate  fan-in  or  fan-out  number  was  also  correctly  updated 
from  default  declarations  such  as  the  undeclared  default  formal  parameter. 

The  data  analysis  technique  issue  encountered  was  the  need  to  analyze  the 

data  via  the   IFS.     Henry's  IFS  was  designed  so  that   a  traversal  of  its  nodes 

analyzing  parent-child  pairs  will  capture  all  the  transitive  relational  data  flows. 

The  transitive  flow  analysis  designed  into  the  present  parser  will  account  for  the 

first   two   layers.     The   reasoning   behind   this   approach  stems  from   a   program 

review.     This    review,    albeit    not    extensive,    was    conducted    looking    for    the 

predominant  use  of  transitive  relations.    The  review  revealed  that  transitivity  is 

not  often  used  and  if  used  is  at  most  two  layers  deep.    There  was  little  use  of  deep 
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transitive  constructs.  Thus,  the  design  approach  selected  will  detect  the  majority 
of  the  transitive  data  flow  paths  without  the  need  for  an  extensive  tree  structure. 
The  "normal"  program  has  few  transitive  relations  but  the  capability  to  analyze 
this  style  of  program  would  add  more  accuracy  to  the  metric. 

Another  design  anomally  of  the  metric  is  the  problem  of  detecting  the 
diff'erence  between  a  function  call  outside  the  package  declaration  and  a  global 
data  structure  manipulation.  Ada  libraries  or  packages  inhibits  the  proper 
analysis  of  a  function  call  as  opposed  to  a  data  structure  read  unless  a  full 
compiler's  output  is  available.  The  present  metric  was  designed  so  that  local 
function  calls  (within  the  package  being  analyzed)  are  properly  valued  but  the 
function  calls  outside  the  package  are  treated  as  data  structure  manipulations  or 
more  specifically  as  global  data  flows. 

D.    CONCLUSION 

The  design  and  implementation  phase  was  driven  by  the  analysis  of  the 
Neider/Fairbanks  parser  portion  of  their  thesis  followed  by  the  modularization  of 
the  Henry  metric.  The  tradeoffs  considered  were:  the  strong  typing  and  range 
checking  of  the  Ada  language,  the  need  for  an  information  flow  tree,  the  need  for 
relative  output  for  the  user  and,  and  most  importantly  the  desire  to  incorporate 
all  of  the  Henry  metric  into  one  Ada  package. 
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III.    DESIGN  AND  TESTING 

A.  THE  EMBEDDED  CODE 

The  previous  work  done  by  Neider/Fairbanks  had  to  be  modified  to  output 
the  necessary  data  for  the  Henry  metric.  This  was  accomplished  through 
embedding  calls  to  the  Write  Henry  Data  procedure  in  ParserO,  Parserl,  Parser2, 
Parsers  and  Bypass  Function  (See  Appendix  C).  The  writing  of  the  Lexeme,  or 
identifier's  name,  was  controlled  by  a  Boolean  that  was  turned  on  or  off"  according 
to  the  position  of  the  parse  of  a  particular  package.  The  design  criteria  was  to 
keep  the  data  gathering  as  simple  as  possible.  If  time  permitted,  a  more  thorough 
and  sophisticated  scheme  could  be  developed.  The  embedded  code  was  thoroughly 
tested  by  two  test  harnesses  that  simulated  a  series  of  Current  Token  Records  in 
the  form  of  an  input  Ada  package. 

B.  THE  HENRY  PACKAGE 

The  first  package  to  be  implemented  was  Henry. pkg.  It  was  conceived  to  be  a 
stand-alone  construction  that  would  initialize  the  data  collection  process,  receive 
data  from  the  other  parsing  packages  and  store  the  raw  incoming  data  in  a  linked 
list.  (See  Appendix  B).  Minimal  variables  and  foreign  procedures  from  other 
packages  are  used.  The  Henry  package's  only  "withed"  packages  are  TEXTIO, 
HENRY   GLOBAL,      HENRY   ANALYSIS      and      HENRYDISPLAY.       This 
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approach  was  considered  necessary  so  that  the  subsequent  changes  or  upgrades 

would  not  affect  other  modules  (ripple  effect).    The  design  was  to  implement  a 

basic  Henry  metric  first  for  Ada  packages  then  to  improve  and  more  fully  develop 

the  Henr>'  analysis  techniques  if  time  allowed.    The  Main  Menu  module  sequences 

the  user  into  the  analysis  and  display  support  packages.    The  modularization  was 

considered    necessary    because    the    analysis    and    display   packages    are   separate 

entities  and  the  separation  will  ensure  maintainability. 

The    initialization    is    conducted    by    procedure    Initialize   Henry    and    the 

declaration  statements  that   assign   initial  values   to  various  Boolean  variables. 

Initialize   Henry  creates  two  head  nodes,  one  for  the  raw  data  linked  list,  the  other 

for  the  procedure  or  function  length  records.    The  raw  data  linked  list  storage  is  a 

straight    line    of    Henry   records.     These    records    have    five    fields    that    identify 

whether  this  is  (1)  local  or  global  declaration,  (2)  the  variable/procedure's  name, 

(3)  an  action  class.  (4)  a  parameter  class  and  (5)  a  pointer  to  the  next  record.  The 

action  class  is  comprised  of  various  identifiers  that  range  from  procedure  type  to 

end   parameters   declare.   Their  purpose   is   to   delineate   the   actions  within  the 

parsed  program  so  that  the  Henr>'  analysis  package  can  look  for  the  data  flow. 

The  parameter  type  field  is  used  to  define  input,  output  or  combination  input 

output  formal  parameters.  The  variable  Henry   Line  count  is  purposely  initialized 

within  this  procedure  to  draw  attention  to  it's  initial  value.    The  array  of  length 

records    is    initially    a    parallel   construct    not    directly    tied    to   the   procedure   or 

function   it   holds  the  data  for.     In  the  analysis  package  a  sequential  process  is 
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produced  where  the  records  are  linked  to  the  data  manipulation  array.  The 
purpose  of  the  length  record  is  to  hold  the  begin  and  end  line  counts  of  each 
procedure  or  function.  These  line  counts  are  used  later  to  compute  the  specific 
modules  length  for  inclusion  in  the  complexity  equation. 

The  receipt  of  incoming  data  is  accomplished  primarily  by 
Write  Henry  Data.  This  procedure  is  supported  by  a  boolean 
Write  Henry  Enable.  This  boolean  turns  on  or  off  the  recording  of  the  incoming 
records  from  the  Get  Current  Token  Record  procedure.  Specifically,  the  boolean 
will  allow  recording  only  selected  data  from  the  incoming  record  stream  selected 
by  the  place  within  the  recursive  descent  parser  that  the  boolean  is  activated. 
This  control  is  necessary  to  pick  and  choose  the  data  that  is  critical  and  to  ignore 
the  remainder. 

The  procedures  Create  Node  and  Clear  Henry  Lexeme  support  the  data 
gathering  scheme.  The  "in  out"  pointers  within  Create  Node  serve  the  purpose  of 
allowing  a  view  of  the  last  record  in  the  incoming  stream  or  to  work  on  the 
current  record.  It  is  arranged  so  that  New  Node  points  to  the  newly  created 
blank  record  and  Last  Record  points  to  the  just  filled  in  trailing  record. 
Procedure  Clear  Henry  Lexeme  is  necessary  because  of  the  way  Ada  handles 
strings.    Create  Line  Node  procedure  functions  identically  to  Create  Node. 

The   incoming  data   is  chosen  from  within  the   Bypass  Function  and  from 

ParserO  to  Parser4  [Ref.5:  pp. 102-160]  by  where  the  calls  to  the  Write   henry   data 

procedure  is  positioned.    The  purpose  of  this  approach  is  to  assure  the  Henry 
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metric  receives  sufficient  information  but  more  importantly  that  the  records 
writen  into  the  linked  list  are  delimited  in  a  particular  fashion  for  ease  of  analysis. 
There  is  still  considerable  data  that  can  be  collected  for  analysis  from  the  parsers 
but  the  Henrj'  metric  is  not  to  the  stage  of  development  where  it  would  be  useful. 
The  added  depth  of  information  could  be  used  in  two  areas;  analysis  and  a  more 
informative  output  from  both  metrics. 

The  Write  Henry  Data  procedure  selectively  enters  the  field  data  into  the 
raw  data  linked  list  records  as  dictated  by  the  incoming  actual  parameters.  That 
is,  the  incoming  data  has  default  settings  but  if  the  data  is  to  be  ignored  then  the 
"null  setting"  is  passed  as  an  actual  parameter.  This  assists  in  the  gathering 
process.  The  design  of  the  data  gathering  modules  is  such  that  modifications 
could  be  easily  implemented.  This  was  purposely  designed  into  them  so  that 
upgrades  would  be  fairly  painless. 

The  Henr>'.pkg  was  constructed  with  modularization  and  maintainability  in 

mind.     It   was   meant   to   be   a   stand   alone   entity   that   receives  data  from   the 

Neider/Fairbanks     Bypass  Function     and     Parser    packages.      It    performs    the 

functions  of  initialization,  data  receipt  and  data  storage  besides  defining  the  data 

structures  used  throughout  the  Henry  metric  packages.  There  are  a  number  of 

improvements    that    could   be    added    to    the    actual    parameter   analysis.     These 

improvements    all    concern   the   wealth   of  options    Ada   provides    in   parameter 

passing  schemes,  such  as,  aggregates,  dot  notation  to  access  hidden  variables  and 

allocators.     Further,   the   present    Henry   metric    does   not   analyze   the   incoming 

34 


actual  parameters  for  expressions  but  the  variables  are  all  considered  for  inclusion 
in  the  complexity  calculation  by  the  transitivity  analysis. 

C.    HENRY  ANALYSIS  PACKAGE 

The  Henry  Analysis  package  comprises  three  procedures  to  set  up  the  raw 
linked  list  data  and  a  fourth  procedure  to  actually  analyze  the  code  for  metric 
calculations.  The  Analysis  procedures  are  called  sequentially  from  the  Henry 
package  and  function  as  support  for  the  Henry  package.  They  operate  on  the 
data  in  sequential  discrete  steps.  They  first  determine  the  formal  parameters, 
then  search  and  identify  procedures  and  variables  and  then  determine  the  metric 
numbers.  The  approach  used  was  to  nibble  each  piece  of  the  tremendously 
complex  data  flow  calculation  down  into  minute  sub-steps  until  all  that  is  left  is 
to  simply  count  the  marks  on  each  record  for  determination  of  the  complexity  or 
global  flow  metric  numbers.  This  approach  removed  the  necessity  for  an  arduous 
single  pass  calculation. 

The  set  up  procedures  are  CLEANUPHENRYDATA, 

SET  UP  HENRY  ARRAY,  and  SPRUCE  UP  HENRY  DATA.  A  support 
function,  LOCAL  NAME,  assists  in  the  setting-up  process.  These  procedures' 
end  product  are  two  metrics,  the  complexity  metric  and  the  global  flow  metric. 

The  Clean  Up  procedure  ensures  that  all  parameter  type  records  have  all 
their  fields  properly  filled.  It  scans  for  their  parameter  lists  all  the  procedures  and 
functions    that    are    declared    in    the    analyzed    package    .     The    field    of   most 
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importance  is  the  classification  of  either  "in,  out  or  in-out"  type  parameters. 
These  fields  are  checked  up  to  the  colon  delimiter  within  the  formal  parameter  list 
and  then  entered  into  all  parameter  type  records  correctly. 

The  Set  Up  procedure  scans  through  the  entire  linked  list  setting  up  another 
array  of  pointers  to  facilitate  the  analysis  process.  The  Henry  Array  records  have 
identifier,  beginning  pointer  and  line  length  record  pointer  entries.  This 
procedure's  purpose  is  to  break  up  the  long  linked  list  into  another  array.  It 
actually  does  not  sub-divide  the  list  it  merely  arranges  an  array  of  pointers  into 
the  linked  list  that  delineate  each  function  or  procedure.  The  resulting  array  is 
called  the  Henry  Array.  The  line  length  record  pointers  are  records  that  hold  the 
stop  and  stop  line  numbers.  These  records  are  eventually  used  to  compute 
procedure/function  lengths. 

The  Spruce  Up  procedure  goes  through  the  Henry  array  data  and  sorts  out 
the  local  and  global  data  flow  paths.  It  does  this  through  the  use  of  the 
LOCAL  NAME  function.  This  function  searches  either  the  Henry  array  for  a 
particular  procedure  name  or  the  package  and  appropriate  procedure's  declaration 
sections  for  the  variable  name  in  question.  Its  purpose  is  to  sort  out  the  local 
procedure  or  function  calls  from  the  global  data  structure  manipulations.  It 
cannot  completely  solve  this  problem  but  defers  final  resolution  to  the  Calculation 
procedure. 

The    Calculate  Metric    procedure   will    again    process   the    Henry    array    data 

looking  for  the  final  resolution  to  local  procedure  or  function  calls  as  opposed  to  a 
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global  data  structure  manipulation.  It  proceeds  in  small  increments  to  finally 
arrive  at  the  complexity  metric  calculation  and  a  global  data  flow  calculation. 
The  complexity  metric  number  is  arrived  at  by  first  considering  all  the  in,  out, 
in-out  formal  parameters  to  calculate  the  fan-in  and  fan-out  numbers.  After  the 
initial  cut  the  fan-in,  fan-out  numbers  are  incremented  upward  by  the  numbers  of 
identified  procedure  actual  parameters  that  feed  these  formal  parameters  and  then 
by  the  the  Transitivity   In  and  Transitivity   Out  functions. 

An  example  of  this  process  would  be  for  procedure  A  with  formal  parameters 
X,  Y.  First  process  parameters  X  and  Y  for  their  explicit  type  adding  1  to  fan-in 
if  its  an  input  parameter  or  1  to  fan-out  if  its  an  output  parameter.  Next  process 
all  the  assignment  expressions  looking  for  a  modification  of  the  formal  parameter. 
If  procedure  A  modifies  parameter  X  prior  to  a  call  to  another  function  increment 
the  fan-out  count  by  the  number  of  statements  after  the  assignment  delimiter. 
Then  go  through  an  analysis  of  transitivity  incrementing  fan-in  or  fan-out 
accordingly.  Finally,  call  up  the  appropriate  record  of  Henry  Line  count  and 
calculate  the  length  of  the  procedure  or  function  in  question. 

The  equation  that  the  process  is  working  toward  solving  is: 

Complexity  =  length  *  (fan-in  *  fan-out)  *  '2 

This  equation  represents  the  local  data  flows  within  the  analyzed  procedure. 

Sallie  Henry  set  the  exponent  of  the  bracketed  expression  to  2  because  of  her 

experience  with  operating  system  code  analysis.  This  program  will  continue  with 
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this  number  until  enough  data  can  be  compiled  to  support  a  change.  Once  this 
calculation  is  done  then  the  global  data  flows  are  analyzed. 

The  global  flows  are  arrived  at  by  first  eliminating  all  other  possibilities. 
Then  the  remaining  choices  have  to  be  foreign  data  flows.  This  process  is  started 
in  the  Spruce  Up  procedure  and  completed  within  the  Metric  Calculation 
procedure.  The  process  is  used  to  find  whether  the  data  structure  is  being  read 
from  or  written  to  or  both. 

The  equation  that  the  analysis  is  striving  to  solve  is: 


Global  flow  =  write  *  (read  +  read-write)  -I- 

read-write    *  (read  +  read-write  -  1) 


This  equation  represents  how  and  by  what  means  the  global  data  structures 
are  manipulated.  The  global  data  analysis  procedure  goes  across  procedure  or 
function  boundaries  whereas  the  previous  complexity  metric  calculations  remain 
within  the  particular  procedure  or  function  under  scrutiny.  This  across-  the- 
border  calculation  is  accomplished  through  the  text  file  that  is  discussed  next. 

Within  the  calculation  procedure  the  initial  entries  for  the  display  package 
are  started.  This  amounts  to  constructing  a  text  file  of  descriptive  terms  and 
indices  of  merit  for  output  in  the  Display  Package.  It  also  provide  a  temporary 
storage  bank  for  the  global  data  information.    This  across-boundary  analysis  of 
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global  flows  was  necessary  because  of  the  implications  of  not  being  able  to  detect 
the  difference  within  the  Ada  code  of  an  access  to  a  data  structure  or  a  function 
call  to  a  "withed"  package. 

In  summary,  the  Analysis  package  is  a  series  of  analytical  steps.  The  purpose 
of  these  steps  is  to  arrive  at  the  complexity  and  global  flow  metrics.  These  indices 
and  additional  data  are  stored  in  a  text  file  for  output  to  the  user  within  the 
Display  package. 

D.    HENRY  DISPLAY  PACKAGE 

The  Henry  Display  package  is  the  user  interface  portion  of  the  metric 
program.  It  provides  the  user  with  four  diff'erent  aspects  of  viewing  the  analyzed 
data.  The  purpose  of  this  package  is  to  show  the  user  the  data  flow 
characteristics  of  the  particular  parsed  input  program.  The  output  data  will  be 
the  fan-in,  fan-out,  length,  complexity,  and  four  global  flow  numbers.  These 
numbers  can  be  presented  in  a  listing  format,  viewed  with  a  help  flle  of 
informiative  paragraphs  or  compared  by  means  of  the  other  portions  of  the 
analyzed  package  to  gain  a  relative  sense  of  merit. 

The  procedures  that  comprise  the  Display  package  are 
LIST   METRIC   DATA  and  WRITE   RELATIVE  DATA  and 

GRAPH  RELATIVE.  The  LIST  METRIC  DATA  procedure  will  output  the 
data  file  compiled  while  in  the  calculation  portion  of  the  previously  discussed 
package.    It  will  be  a  straight  listing  of  information  that  will  be  grouped  by  each 
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element  in  the  calculation  of  the  complexity  or  global  flow  numbers,  such  as  all 
procedures  are  grouped  under  the  head  of  FAN-IN.  The  purpose  of  this  listing  is 
to  show  each  procedure  or  functions  component  figure  in  the  calculation  of  the 
final  complexity  and  global  figures.  If  the  programmer  is  in  a  compile,  test,  edit, 
recompile  mode  of  operation  this  will  provide  a  spotlight  on  where  to  improve  the 
data  flow  "choke-  points".  These  data  flow  critical  points  will  be  seen  as  either 
high  global  flow  or  high  complexity  numbers.  In  short,  the 
LIST  METRIC  DATA  is  designed  for  a  more  sophisticated  programmer  wishing 
to  edit-and-run  and  see  the  results  of  particular  programming  style  changes. 

The  WRITERELATIVEDATA  display  will  provide  the  same  format  of 
data  but  the  numbers  will  have  been  normalized.  Accompanying  each  number  set 
will  be  a  short  narrative  keyed  to  the  relationships  of  the  particular  numbers. 
That  is.  if  the  user  sees  a  complexity  number  of  125  beside  the  procedure  X  he 
will  be  provided  with  an  explanation  that  that  number  is  not  too  far  out  of  line  in 
comparison  to  the  other  procedures  or  functions  analyzed  within  this  package. 
The  purpose  of  this  approach  is  to  normalize  the  output  numbers  to  provide  a 
relative  comparison  for  a  more  user  friendly  approach  to  the  mysterious  metric 
number  generation. 

There  is  an  additional  procedure  within  the  Display  package  that  provides  a 

complete  listing  of  the  raw  input  data.    This  procedure  will  most  likely  be  of  no 

use   to   anyone   except   those  programmers  who   are  extremely   interested   in  the 

factors  that  lead  to  the  particular  numbers  presented. 
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The  final  package  for  viewing  the  data  is  the  graphical  presentation  module. 
It  takes  the  relative  data  and  manipulates  the  floating  point  numbers  to  achieve  a 
bar  chart  display. 

In  summary,  the  Display  package  will  provide  the  user  with  information  in  a 
variety  of  formats  so  that  he  can  reach  a  conclusion  from  relative  merit  or 
absolute  input  numbers.  The  data  flow  numbers  will  point  out  the  critical  data 
flow  points  within  a  procedure  so  that  the  programmer  can  better  see  where  to 
improve  or  expend  the  most  eff'ort.  The  purpose  of  the  output  data  is  to  show  the 
user  where  to  improve,  not  how  to  improve. 

E.    TESTING 

The  testing  of  the  design  was  conducted  as  the  modules  were  being  built  and 
at  the  integration  step  prior  to  the  final  product.  This  was  accomplished  through 
the  use  of  test  harnesses  that  simulated  the  particular  module's  inputs  and 
through  test  input  programs  that  were  hand  analyzed  to  verify  the  metric 's 
outputs. 

The  testing  of  the  Henry  package  was  accomplished  by  gradually  building  a 
more  thorough  test  harness  as  each  previous  test  was  successful.  The  final  test 
harness  encompassed  over  200  input  records  that  simulated  a  myriad  of  token 
record  inputs.  The  testing  of  the  Henry  module  presented  some  difficulty  because 
it  is  so  intimately  tied  to  the  parsers.  This  was  overcome  by  simulating  the 
Bypass  Support  package  as  a  partial  input  and  the  test  harness  as  the  balance  of 
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the  test  vehicle.  The  package  performed  well  within  the  test  harness  and 
functions  adequately  within  the  context  of  the  entire  program. 

The  testing  of  the  analysis  package  of  the  Henry  metric  again  was  an  iterative 
build  of  the  harness.  The  testing  accomplished  after  all  the  Henry  metric 
packages  were  integrated  was  accomplished  on  the  same  group  of  programs 
provided  by  the  NWC  programmers  to  test  the  Halstead  metric  integration.  The 
harness  testing  was  comprised  of  a  50  step  program  that  simulated  a  package  with 
three  independent  procedures/functions  utilized  within  its  scope.  There  were 
intentional  references  outside  the  scope  of  the  test  harness  package  to  determine  if 
the  global  call  detection  scheme  functioned  properly.  In  all,  the  test  harness 
exercised  every  possible  data  flow  scheme  analyzable  by  the  Henry  metric 
including  one  that  would  be  a  missed  call.  The  analysis  package  performs 
adequately  within  the  scope  of  the  harness.  Testing  revealed  that  the  code  within 
the  analysis  phase  was  non-  reentrant  which  required  a  the  use  of  a  boolean  to 
define  the  status  of  the  call  to  the  package.  This  boolean  will  protect  the  data 
structure  and  effectively  make  the  code  reentrant. 

The  display  module  was  tested  with  the  same  driver  harness  as  the  analysis 

package.     The   results   were   used   to   fine   tune   the   package   and   to   debug   the 

problems.    The  process  used  was  to  call  the  analysis  package  from  the  display 

package  and  drive  the  display  package  with  the  test  harness.    This  is  also  how  the 

integrated  program  performs.    The  results  were  adequate  from  the  stand  point  of 

the  test  harness  but  need  some  refinement  when  using  the  whole  program. 
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The  summary  of  testing  would  be  extensive  use  of  complicated  test  harnesses. 
Since  a  test  harness  has  to  simulate  all  the  inputs  to  a  module  that  the  tested 
code  could  possibly  see  during  integration,  they  are  difficult  to  build  much  less 
debug.  The  debugging  problem  comes  from  the  question  'is  it  the  code  or  is  it  the 
harness?'.  The  test  harness  approach  is  quite  fruitful  from  two  orientations:  (1)  it 
forces  the  programmer  into  a  thoroughly  understanding  his  code  and  (2)  the 
harness  construction  will  lead  the  programmer  into  optimizing  his  code.  Why 
doesn't  the  programmer  already  understand  his  code?  He  does  but  the 
ramifications  of  a  certain  approach  does  not  come  surface  until  the  design  of  a  test 
harness  is  considered.  The  optimization  is  driven  by  the  need  to  get  accurate,  fast 
results  so  that  the  troubleshoot-repair-compile-troubleshoot  regimen  can  proceed 
fairly  rapidly.    This  is  a  real  concern  with  the  tremendous 
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IV.   CONCLUSIONS 

A.    IMPLEMENTATION 

The  Henry  metric  was  implemented  in  as  modularized  a  fashion  as  possible. 
The  intent  was  to  allow  for  improvements  through  a  more  thorough  use  of  the 
parser's  information  in  AdaMeasure's  first  revision.  Also,  certain  aspects  of  the 
Henry  metric  were  not  implemented,  but  it  is  now  felt  that  they  would  add  depth 
to  the  analysis  process.  In  particular,  the  first  change  should  be  that  the 
Information  Flow  Structure  be  added.  This  tree-like  structure  will  allow  the 
analysis  of  hidden  calls  but  will  still  not  detect  the  missed  call  problem  discussed 
earlier.  The  missed  call  problem  will  most  likely  only  be  solved  through  the  use  of 
the  Program  Counter  Register,  but  this  approach  defeats  the  idea  of  a  high  level 
language.  The  final  improvement  would  be  to  add  analysis  of  the  "withed" 
packages  so  that  an  interface  table  could  be  constructed. 

The  program  was  incorporated  into  the  previous  work  by  Neider  and 
Fairbanks.  Their  work  was  extensive  and  deserves  favorable  mention  because  it 
made  the  implementation  of  the  Henry  metric  considerably  easier.  The  output  of 
the  program  is  still  in  need  of  sophistication  and  improvement.  In  particular,  two 
improvements  are  needed:  (1)  explaining  the  theory  behind  the  metric  and  (2) 
conveying  the  ideas  to  the  user.  For  an  example,  a  high  global  data  flow  indicates 
an  overworked  global  data  structure.  What  should  the  metric  present  to  the  user? 
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The  average  programmer  might  not  see  the  relevance  of  this  and  would  miss  the 
indication  that  a  critical  point  in  the  data  flow  should  probably  be  revised. 

B.    THE  FUTURE  OF  METRICS 

Metrics  are  tools.  They  point  out  areas  of  weakness.  The  metric  will  show  a 
direction  to  proceed  even  in  the  absence  of  an  absolute  answer  as  to  the 
correctness  of  the  analyzed  code. 

The  importance  of  metrics  will  grow  as  the  size  of  programs  grow.  We  do  not 
know  how  important  metrics  will  become  but  it  does  seem  clear  that  there  is  a 
need  for  something  that  helps  improve  code  quality  and  is  fairly  painless  to  use. 
The  emphasis  on  "good"  code  will  continue  to  be  in  the  forefront  of  the  Armed 
Service's  concerns  because  of  their  intense  involvement  in  real  time  embedded 
programs.  These  programs  present  a  real  challenge  for  incorporation  of  changes, 
improvements  or  any  other  form  of  miaintenance  programming.  The  purpose  of 
metrics  in  this  environment  would  be  to  point  the  way  to  good  modularized 
design. 

The  metric  should  be  part  of  the  test  scenario  besides  being  an  integral 
member  of  the  life  cycle  of  the  program.  The  metric  will  force  quality  control 
without  the  painful  process  of  formal  inspections.  The  formal  process  has  its 
place  but  the  metric  tool  could  perform  more  than  the  inspection.  The  metric 
tool  should  be  incorporated  into  the  test  cycle  as  a  meter  of  improvement.  This 
immediate  feedback   to  the  programmer  will  be  beneficial.    The  manager  could 
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also  use  the  absolute  number  as  a  goal  for  acceptance.  This  approach  will  provide 
the  manager  with  the  data  needed  at  decision  points  in  the  life  cycle  of  a 
program.  The  absolute  number  could  also  be  tied  to  the  program  throughout  its 
life  as  a  measure  of  improvement  or  degradation  over  time.  The  uses  are  many, 
as  the  reader  can  see.  The  importance  of  the  metric  cannot  be  overstated  when 
the  future  holds  programs  that  will  span  millions  of  lines  of  code. 

Metrics  are  important.  They  hold  out  the  hope  of  an  automated  tool  that 
will  guide,  interpret,  and  assess  progress  for  programmers  and  management  alike. 
I  hope  that  the  work  of  this  metric  will  assist  in  advancing  metrics  and  the  use  of 
the  Ada  language. 
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APPENDIX  A:  INFORMATION  FLOW  MECHANISMS 


MECHANISMS  FOR  INFORMATION  FLOW  ANALYSIS 


As  Sallie  Henry  so  succintly  states: 

The  information  flow  analysis  takes  place  in  three  phases.  The  first  phase 
involves  generating  a  set  of  relations  indicating  the  flow  of  information  through 
input  parameters,  output  parameters,  returned  values  from  functions  and  data 
structures. 


General  Format  of  a  Relation 


The  generation  of  relations  is  first  prefaced  with  a  quick  review  of  relational 
format. 

L  <-  Rl,  R2  ...Rcount; 

Where  L  may  be  in  any  one  of  the  following  forms: 

1.  P.DS         P  is  the  name  of  a  procedure  and  DS  the  data 

structure. 

2.  P.O,         P  is  the  procedure  name  and  O  is  the  return  value. 

3.  P.j.O        P  is  the  procedure  j  is  an  integer  representing 

the  formal  parameter  position,  and  O  is  the  jth 
Output  parameter. 

4.  P.j.I        P  is  the  procedure,  j  is  an  integer  representing 

the  jth  parameter,  and  I  is  the  jth  input 
parameter. 

Ri  may  be  in  one  of  the  following  forms: 

1.  S.DS         S  is  a  procedure  name  and  DS  is  the  name  of  a  data 

structure. 

2.  S.O  S  is  a  procedure  name  and  O  is  the  returned  value. 

3.  S.j.I        S  is  the  procedure  name,  j  is  the  jth  parameter 

and  I  is  the  jth  input  parameter. 

4.  S.j.O        S  is  the  procedure  name,  j  is  an  integer 

representing  the  jth  parameter  in  the  list  and  O 
is  the  output  parameter. 

5.  S.null       S  is  the  procedure  name,  null  represents  no  data 
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6.  S.cons.     S  is  the  procedure  name  and  constant  a  value 

used  within  S. 

7.  S. error     S  is  the  procedure  name  and  error  represents  an 

invalid  flow  of  information  through  procedure  S. 


RULES 


1.  L  is  of  the  form  P.DS  then 

this  form  is  used  only  to  generate  the  relations  from 
procedure  P  that  updates  DS  with  Ri. 

2.  L  is  of  the  form  P.O  then 

This  is  used  only  in  generating  the  relations  from  procedure 
P  that  produce  an  output. 

3.  L  is  of  the  form  P.j.O  then 

This  is  used  when  generating  the  relations  that  produce  an 
input  of  the  jth  parameter  in  the  procedure's  formal 
parameter  list.  There  must  be  a  unique  relation  for  each  of 
P's  parameters. 

4.  L  is  of  the  form  P.j.I  then 

This  is  used  when  generating  the  relations  for  procedure  P 
that  produce  an  input  for  the  jth  parameter.  Another 
procedure  T  calls  P  to  indicate  that  the  jth  parameter  of  P 
receives  the  input  update. 

5.  Ri  is  of  the  form  S.DS  then 

Procedure  S  reads  information  from  DS  this  format  is  used  to 
indicate  a  read  only. 

6.  Ri  is  of  the  form  S.O  then 

Relations  are  generated  that  come  from  procedure  T  that  are 
return  values  to  T  from  S. 

7.  Ri  is  of  the  form  S.j.I  then 

For  generating  relations  for  procedure  S  that  indicates  S's 
jth  input  parameter  passes  information  to  L. 

8.  Ri  is  of  the  form  S.cons. 

Then  S  causes  a  constant  number  or  string  to  flow  to  L. 

9.  Ri  is  of  the  form  S.Null  then 

This  is  used  to  indicate  when  S  does  not  update  a  parameter, 
that  is,  the  parameter  was  strictly  input  only. 

10.  Ri  is  of  the  form  S. error  then 

S  calls  T  and  one  of  the  parameters  to  T  is  an  output  only 
thus  if  S  attempts  to  input  a  value  this  would  be  an  error. 
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ANALYSIS  OF  CALLS 


The  following  two  procedures  X  and  Y,  exhibit  all  possible  calling  structures 
in  the  light  of  information  flow  analysis.  NP  stands  for  not  possible,  NC  for 
calls  and  the  numbers  beneath  are  used  for  later  reference. 


no 


The  pairs  1,  3,  5,  7,  13,  and  15  cannot  appear  in  a  flow  of  data  path  because 
for  DS's  the  only  assignment  and  reads  allowed  are  from  procedures  or  functions. 
The  other  not  possibles  stem  from  input  parameters  not  flowing  into  DS's  and  not 
flowing  into  output  parameters.  Entries  2  and  4  indicate  X  calling  Y,  receiving 
information  from  Y  and  using  this  information  to  update  a  DS.  The  rest  of  the 
possibilities  can  be  reasoned  in  like  manner  except  entries  10  and  12,  which 
represent  calls  via  a  third  procedure.  Here  procedure  Z  calls  Y  and  passes  the 
returned  value  from  Y  to  X.  This  represents  a  no  call  between  X  and  Y  but  there 
is  a  data  flow. 


TABLE  1. 


LOCAL  CALL  TABLE                                                        i 

1 

X.DS 

X.O                      X.k.I 

X.k.O 

Y.DS 

NP 

1 

NP                  Y  calls  X 
5                          9 

NP 
13 

Y.n 

X  calls  Y 
2 

X  calls  Y               NC 
6                          1Q> 

X  calls  Y 
14 

Y.k.i 

NP 
3 

NP               Y    calls  X 
7                          U 

NP 

15 

Y.k.O 

X  calls  Y 
4 

X  calls  Y               NC 
8                         IS 

X  calls  Y 
16 

■                        ■■   ■              ....    ....   ..  . .   , 
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All  data  flows  from  the  highest  calling  structure,  eventually  being  deposited 
in  the  data  structures.    Analysis  of  the  table's  data  confirms  this  premise. 


MEMORYLESS  PROCEDURES 


Some  procedures  keep  no  record  of  their  data  passing  or  the  data  supplied. 
These  procedures  are  used  to  do  housekeeping  for  memory  management,  for 
example,  but  their  analysis  for  data  flow  would  produce  a  false  amount  of  data 
transactions.  Another  area  that  these  procedures  appear  in  are  arithmetic 
operations  that  are  sometimes  duplicated  in  hardware  such  as  double  precision 
math  etc.  This  discussion  leads  to  the  problem  that  these  procedures  would  be 
difficult  to  discern  in  an  automated  process.  That  is,  if  memoryless  procedures  are 
not  to  be  considered  in  data  flow  analysis  some  form  of  human  decision  making  is 
required.  It  should  be  noted  that  this  is  another  premise  that  the  automation  of 
the  Henry  metric  is  based  on.    The  absolute  numbers  for  the  Henry  metrics  would 


TABLE  2. 


GLOBAL  CALL  TABLE 

X.DS 

X.O                       X.U.I 

X.U.0 

Y.DS 

NP 

1 

NP                   Y  flows    X 
5                           9 

NP 
13 

Y.O 

Y  flows    X 
2 

Y  flows    X          Y  flows    X 
6                          10 

Y  flows    X 
14 

Y.k.I 

NP 
3 

NP                 Y  flows    X 
7                          11 

NP 
15 

Y.k.O 

Y  flows    X 
4 

Y  flows    X          Y  flows    X 
S                         IS 

Y  flows    X 
16 

1 
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be  inflated  if  memoryless  procedures  are  not  eliminated  from  the  analysis.  In 
short  a  memoryless  procedure  should  be  removed  from  the  code  to  be  analyzed  if 
a  more  accurate  assessment  or  if  the  absolute  numbers  produced  are  being  used 
for  a  comparative  study. 
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APPENDIX  B:  HENRY  METRIC  CODE 


********************************************************** 

-  TITLE:  AN  ADA  SOFTWARE  METRIC 

--   MODULE  NAME:      PACKAGE  HENRY  GLOBAL 

-  DATE  CREATED:     09  MAY  87 
--    LAST  MODIFIED:    19  MAY  87 

-  AUTHOR:  LCDR  PAUL  M.  HERZIG 


—    DESCRIPTION:    This  package  contains  the  data  declarations 
and  basic  procedures  used  throughout  the  Henry  metric. 

************************************************************ 

with  GLOBAL,  TEXTIO; 
use   GLOBAL,  TEXTJO; 

package  HENRY   GLOBAL  is 

package  INTEGER  10  is  new  TEXT  10. INTEGER   lO(INTEGER); 
use  INTEGER   10; 

package  REALIO  is  new  TEXT  lO.FLOATJO(FLOAT); 
use  REALIO; 

—Real   lO  produces  floating  point  output 

MAX   ARRAYSIZE    :  constant  integer     :=  50; 
MAXLINESIZE     :  constant  integer     :=  76; 
DUMMY9S  :  constant  integer     :=  9999; 

NULL   CHAR  :  constant  character  :=  '  '; 

— DUMMY9s  are  used  for  false  data  input  to  the  line  length  calculations 

type  DECLARED  TYPE  is       (BLANK,  LOCAL  DECLARE,  GLOBAL  DECLARE); 

type  ACTIONTYPE     is       (UNDEFINED, 
HENRY  HEAD  NODE, 
PACKAGE  TYPE, 
PROCEDURETYPE, 
FUNCTION  TYPE, 
PARAM  TYPE, 
ASSIGN  TYPE, 
IDENT  TYPE, 
DATA  STRUCTURE, 
FUNCALL  OR  DS, 
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PROCALL  OR  DS, 
END  PARAM  DECLARE, 
END   ACTUAL  PARAM, 
END   DECLARATIONS, 
END   ASSIGN  TYPE, 
END   PACKAGE  DECLARE, 
END   PACK  AGE  TYPE, 
END  FUNCTION  TYPE, 
END   PROCEDURE  CALL); 

type  PARAM  CLASS       is  (NONE,  IN  TYPE,  OUT  TYPE,  IN  OUT  TYPE, 

ACTUAL   PARAM); 
subtype  FORMAL  PARAM  CLASS  is  PARAMCLASS  range  IN  TYPE.. IN  OUT  TYPE; 
subtype  LEXEME  TYPE   is   string  (1..  MAXLINESIZE); 
subtype  ENDUNITS      is    ACTIONTYPE  range 

ENDFUNCTION  TYPE. END  PROCEDURE  CALL; 

—Declared,  action  and  parameter  classes  or  types  are  used 
—  in  the  Henry  record  data  collection  process 

type  HENRY   RECORD; 

type  POINTER  is  access  HENRY  RECORD; 

type  HENRY   RECORD  is  record 

IDENTITY       :  DECLARED  TYPE; 

NOMEN  :  LEXEME  TYPE: 

TYPE  DEFINE   :  ACTION  TYPE; 

PARAM  TYPE     :  PARAMCLASS; 

NEXTl  :  POINTER; 

end  record; 

—Henry  record  is  the  workhorse  storage  medium 


type  HENRY   LINE  COUNT  RECORD; 

type  LINEPOINTER  is  access  HENRY  LINE  COUNT  RECORD; 

type  HENRY   LINE  COUNT  RECORD  is  record 

ID   NAME  :  LEXEME  TYPE; 

START  COUNT  :  INTEGER; 

STOP  COUNT  :  INTEGER; 

NEXT  REC  :  LINE  POINTER; 

end  record; 

—Henry  line  count  record  is  used  to  claculate  the  length  of  procedures 
—or  functions 

type  HENRY   DATA  is  record 
NAME  OF  DATA  :  LEXEME  TYPE; 

BEGIN   POINTER  :  POINTER; 

LINE  LENGTHPOINTER     :  LINE  POINTER; 

end  record; 

—Henry  data  records  are  used  to  delineate  the  functions  and  procedures 
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—for  easier  data  calculations 

type  HENRY  DATA   ARRAY  is  array  (1  ..MAXARRAYSIZE)  of  HENRYDATA; 

type  OUTPUTDATA  is  record 

TYPE  OF  :  ACTION  TYPE  :=  UNDEFINED; 

NAME  OF  :  LEXEME  TYPE; 

TYPEFAN  IN        :  FLOAT  :=  0.0; 

TYPEFANOUT       :  FLOAT  :=  0.0; 

TYPE  COMPLEXITY    :  FLOAT  :=  0.0; 

TYPE  READ  :  FLOAT  :=  0.0; 

TYPEWRITE         :  FLOAT  :=  0.0; 

TYPE  READWRITE    :  FLOAT  ;=  0.0; 

TYPE  FLOW  :  FLOAT  :=  0.0; 

CODE  LENGTH         :  INTEGER  :-  0; 
end  record; 


—Output  data  records  hold  the  final  calculation  numbers  for  storage  into 
—an  output/input  file 

type  OUTPUTARRAY  is  array  (1..MAX   ARRAY  SIZE)  of  OUTPUT  DATA; 

NEXT  HEN,  LAST  RECORD,  NEW   RECORD, 

HEAD,  NAME  POINTER  :  POINTER; 

HENRY   ARRAY  : HENRY  DATA   ARRAY; 

HENRY   LINECOUNT  :  integer  :=  0; 

OUT  PUT  DATA  :  OUTPUT  ARRAY; 

LINE  COUNT  RECORD  :  HENRY   LINE  COUNTRECORD; 

HEAD  LINE,  NEXT  LINE,  LASTLINE       :  LINE  POINTER; 

PACKAGE  BODY  DECLARE, 

ASSIGN  MARKER, 

GLOBAL   MARKER, 

NAME  TAIL  SET, 

ASSIGN  STATEMENT, 

FUNCTION  PARAM  DECLARE, 

FORMAL   PARAM  DECLARE  :  BOOLEAN  :=  FALSE; 

FIRST   HENRY  CALL  :  BOOLEAN  :=  TRUE; 

DUMMY  LEXEME  :  LEXEME  TYPE; 

procedure  CREATE  NODE(NEW   NODE,  LAST  RECORD  :  in  out  POINTER); 
procedure  CREATE  LINE_COUNTNODE(NEXT_LINE, 

LAST   LINE      :  in  out  LINE  POINTER); 
procedure  INITIALIZE  HENRY(HEAD         :  in  out  POINTER; 
HEAD   LINE  ;  in  out  LINEPOINTER); 


procedure  CLEAR  HENRY  LEXEME(HENRY  LEXEME       :  in  out  LEXEME  TYPE); 
end  HENRYGLOBAL; 
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package  body  HENRYGLOBAL  is 

—procedure  creates  Henry  record  nodes  for  data  storage 

procedure  CREATE  NODE(NEW_NODE,  LASTRECORD  :  in  out  POINTER)  is 

TEMP   POINTER  :  POINTER; 

begin 

put(result   file,  "in  create  henry  node");  new   line(result   file); 

TEMP   POINTER  :=  new  HENRY^^RECORD^ 

TEMP  POINTER. IDENTITY      :=  BLANK; 

for  I  in  l.MAXLINE  SIZE  loop 
TEMP   POINTER. NOMEN(I)     :=  NULL   CHAR; 

end  loop; 

TEMP  POINTER. TYPE  DEFINE  :=  UNDEFINED; 

TEMP  POINTER. PARAM  TYPE  :=  NONE; 

NEW  NODE. NEXTl      :=  TEMP  POINTER; 

LAST  RECORD        ~  NEW  NODE; 

NEW  NODE         :=  TEMPPOINTER; 
end  CREATE  NODE; 


—creates  line  count  nodes  to  hold  the  length  data  for  each  procedure  or 
—function 

procedure  CREATE  LINE  COUNT_NODE(NEXT_LINE, 

LAST  LINE      :  in  out  LINE  POINTER)  is 

TEMP  POINTER  :  LINE  POINTER; 

begin 

put(result   file,  "in  henry  create  line  node");  new   line(result   file); 

TEMP   POINTER  :=  new  HENRY  LINE  COUNT  RECORD; 

for  I  in  l.MAXLINESIZE  loop 
TEMP   POINTER. ID_NAME(I)  :=  NULL   CHAR; 

end  loop; 

TEMP  POINTER. STARTCOUNT  :=  DUMMY9s; 

TEMP   POINTER. STOPCOUNT    :=  DUMMY9s; 

NEXT  LINE.NEXT   REC  :-  TEMP  POINTER; 

LAST   LINE  :=  NEXT  LINE; 

NEXT  LINE  :=  TEMP  POINTER; 

end  CREATE  LINE  COUNT   NODE; 


—sets  all  of  the  variables  to  their  initial  values  besides 
—creating  the  first  Henry  record  and  line  count  record 

procedure  INITIALIZE  HENRY(HEAD         :  in  out  POINTER; 
HEADLINE  :  in  out  LINEPOINTER)  is 
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HEAD  STRING  :  STRING (1.. 9)    :=  "HEAD  NODE"; 
SIZE  :  INTEGER  :=  9; 

begin 

CREATE(HENRY   FILE,  out   file,  HENRYFILE   NAME); 

put(HENRY   FILE,  "in  INITIALIZE  HENRY");  newJine(HENRY  FILE); 

CREATE(HENRY  OUT,  out   file,  HENRY  OUTNAME); 

HEAD  :=  new  HENRY  RECORD; 

HEAD. N0MEN(1.. SIZE)  :=  HEAD  STRING; 

HEAD. IDENTITY  :=  BLANK; 

HEAD. TYPE  DEFINE      :=  HENRY  HEADNODE; 

HEAD. PARAM  TYPE       :=  NONE; 

NEXT  HEN  :=  HEAD; 

CREATE  NODE(NEXT  HEN,  LAST  RECORD); 

HENRY  LINE  COUNT      :=  0; 

DUMMY  LEXEME(l)       :=  NULL   CHAR; 

HEAD   LINE  :=  new  HENRY  LINE  COUNT   RECORD; 

HEAD  LINE. ID  NAME(1.. SIZE)    :=  HEAD   STRING; 

HEAD   LINE. START  COUNT  :=  DUMMY9s; 

HEAD   LINE. STOP  COUNT  :=  DUMMY9s; 

NEXT  LINE  .=  HEAD  LINE; 

CREATE  LINE  COUNT  NODE(NEXT  LINE,  LAST  LINE); 
end  INITIALIZE  HENRY; 


—clears  the  input  string  to  null  characters 

procedure  CLEAR_HENRYLEXEME(HENRY   LEXEME  :  in  out  LEXEME  TYPE)  is 

begin 

put(HENRY  FILE,  "IN  CLEAR  HENRY  LEXEME");  NEW   LINE(HENRY  FILE); 
FOR  I  in  1  ..MAXLINESIZE  loop 
HENRY  LEXEME(I)  :=  NULL  CHAR; 
end  loop; 
END  CLEAR  HENRY  LEXEME; 

END  HENRY  GLOBAL; 


--  TITLE:  AN  ADA  SOFTWARE  METRIC 

-  MODULE  NAME:      PACKAGE  HENRY  METRIC 
--  DATE  CREATED:     06  APR  87 

-  LAST  MODIFIED:    15  MAY  87 

--  AUTHORS:  LCDR  PAUL  M.  HERZIG 
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—    DESCRIPTION:    This  package  contains  the  Henry  metric  data 
collection  and  program  control  routines. 

*************************************************************** 

with  GLOBAL,  HENRY  GLOBAL,  HENRY  ANALYSIS,  HENRY  DISPLAY,  TEXT  10; 
use   GLOBAL,  HENRYGLOBAL,  HENRYANALYSIS,  HENRYDISPLAY,  TEXTIO; 

package  HENRY  is 


procedure  WRITE  HENRY   DATA(ID         :  in  DECLARED  TYPE  :=  BLANK; 
IN  NAME  :  in  LEXEME  TYPE  :=  DUMMY  LEXEME; 
DEFINE    :  in  ACTION  TYPE  :=  UNDEFINED; 
PARAM     :  in  PARAMCLASS  :=  NONE; 
LINK      :  in  POINTER); 


procedure  UPDATE  LINE  COUNT; 

procedure  WRITE  LINE  COUNT(IN_NAME  :  in  LEXEME_TYPE:=  DUMMY  LEXEME; 

FIRST  COUNT  :  in  INTEGER  :=  DUMMY9s; 

LAST  COUNT    :  in  INTEGER  :=  DUMMYQs; 

PTR  :  in  LINEPOINTER); 

end  HENRY; 


package  body  HENRY  is 


--produces  the  written  data  records  from  the  parser  inputs 
—data  is  only  written  if  it  is  something  other  than  the 
—null  settings 


procedure  WRITE  HENRY   DATA(ID         :  in  DECLARED  TYPE  :=  BLANK; 
IN  NAME  .  in  LEXEME  TYPE:=  DUMMY  LEXEME; 
DEFINE    :  in  ACTION  TYPE  :=  UNDEFINED; 
PARAM     ;  in  PARAM  CLASS  :=  NONE; 
LINK      :  in  POINTER)  IS 
begin 

put(result_file,  "in  write  henry  data");  new_line(result_file); 
If  ID        ~     /=  BLANK  then 
LINK. IDENTITY     :=  ID; 
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case  ID    is 

when  LOCALDECLARE    =>  put(RESULT_FILE,  "Local  declare"); 
when  GLOBALDECLARE  =>  put(RESULT   FILE,  "Global  declare"); 
when  others  ->  put(RESULT_FILE,  "Undeclared"); 

end  case; 
else  put(RESULT  FILE,  "NO  DECLARATION"); 
end  if; 

new_line(RESULT_FILE); 
If  IN  NAME(l)    /=  NULL   CHAR  then 
LINK.N0MEN(1..MAX  LINE  SIZE)  :=  IN  NAME(1.. MAX  LINE  SIZE); 
PUT(RESULT  FILE,  IN  NAME); 
ELSE  PUT(RESULT  FILE,  "NO  NAME"); 
end  if; 

new_line(RESULT_FILE); 
If  DEFINE       /=  UNDEFINED  then 
LINK. TYPE  DEFINE  :=  DEFINE; 
case  DEFINE  is 

when    UNDEFINED  =>  put  (RESULT   FILE,  "Undefined"); 

when    HENRY   HEAD   NODE     =>  put(RESULT   FILE,  "Henry  Head  Node"); 
when    PACKAGETYPE         =>  put(RESULT   FILE,  "Package  declaration"); 
when    PROCEDURETYPE      =>  put(RESULT_FILE,  "Procedure  declaration"); 
when    FUNCTION  TYPE       =>  put(RESULT_FILE,  "Function  declaration"); 
when    PARAMTYPE  =>  put(RESULT_FILE,  "Parameter  declaration"); 

when    ASSIGNTYPE  =>  put(RESULT   FILE,  "Assignment  delimiter"); 

when    IDENTTYPE  =>  put(RESULT_FILE,  "Identifier"); 

when    DATASTRUCTURE      =>  put(RESULT_FILE,  "Data  structure  descriptor"); 
when    FUNCALLORDS        =>  put(RESULT   FILE,  "Function  or  data  descriptor"); 
when    PROCALL   OR   DS        =>  put(RESULT   FILE,  "Procedure  or  data  descriptor"); 
when    END   PARAMDECLARE  =>  put(RESULT   FILE,  "End  parameter  delimiter"); 
when    ENDACTUALPARAM    =>  put(RESULT_FILE,  "End  actual  parameter  delimiter"); 
when    ENDDECLARATIONS    =>  put(RESULT_FILE,  "End  declaration  delimiter"); 
when    END   ASSIGNTYPE     =>  put(RESULT_FILE,  "End  assignment  statement  delimiter"); 
when    ENDPACKAGEDECLARE  =>  put(RESULT_FILE,  "End  package  declaration  delimiter"); 
when    END   PACKAGE  TYPE   =>  put(RESULT_FILE,  "End  package  delimiter"); 
when    END   FUNCTION  TYPE  =>  put(RESULT_FILE,  "End  function  delimiter"); 
when    ENDPROCEDURE  CALL  =>  put(RESULT_FILE,  "End  procedure  delimiter"); 
when  others  =>  put(RESULT_FILE,  "Unknown"); 

end  case; 

new   line(RESULT_FILE); 
end  if; 
IfPARAM         /=  NONE   then 

LINK.PARAMTYPE    :=  PARAM; 
CASE  PARAM  IS 

WHEN  INTYPE  =>  PUT(RESULT  FILE,  "IN  PARAM"); 
WHEN  OUT  TYPE  =>  PUT(RESULT  FILE,  "OUT  PARAM"); 
WHEN  IN  OUT  TYPE  =>  PUT( RESULT  FILE,  "IN  OUT  PARAM"); 
WHEN  OTHERS  =>  PUT(RESULT  FILE,  "NONE"); 
END  CASE; 
end  if; 

new   line(RESULT  FILE); 
end  WRITE  HENRY  DATA; 
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—increments  the  line  count  for  eventual  inclusion  into 
—the  calculation  of  a  particular  procedures  total  length 
—the  length  number  is  used  in  the  complexity  calculation 

procedure  UPDATELINECOUNT  is 


begin 

put(result   file,  "in  update  line  count");  new   line(result   file); 

if  not  FORMAL   PARAM  DECLARE  then" 
HENRY  LINE  COUNT  :=  HENRY  LINECOUNT  +  1; 

end  if; 
end  UPDATE  LINE  COUNT; 


—produces  the  records  to  hold  the  line  count  information 
--the  records  are  not  initially  tied  to  a  particular  procedure 
--but  are  a  parallel  data  structure  until  in  the  Hen   anal.pkg 
--where  they  are  linked  to  the  procedure  that  they  hold  the 
—data  for 

procedure  WRITE  LINE  COUNT(IN  NAME  :  in  LEXEME  TYPE:=  DUMMY  LEXEME; 
FIRSTCOUNT  :  in  INTEGER  :=  DUMMY9s; 
LAST  COUNT    :  in  INTEGER  :=  DUMMY9s; 
PTR  :  in  LINE  POINTER)  IS 

begin 

put(HENRY   FILE,  "m  WRITELINE  COUNT");  new_Ime(HENRY_FILE); 
put(result   file,  "in  write  line  count");  new   line(result   file); 

IfIN  NAME(l)     /=  NULL  CHAR  then" 

PTR.IDNAME(1. .MAX   LINE  SIZE)     :=  IN  NAME;  end  if: 

If  FIRST  COUNT  /=  DUMMY9s  then  PTR.STARTCOUNT  ;=  FIRST  COUNT;  end  if; 

If  LAST   COUNT    /=  DUMMYQs  then  PTR.STOPCOUNT    :=  LAST  COUNT;  end  if; 

end  WRITE  LINECOUNT; 
end  HENRY; 


TITLE:  AN  ADA  SOFTWARE  METRIC 

-   MODULE  NAME:      PACKAGE  HENRY  ANALYSIS 
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•  DATE  CREATED:     29  APR  87 

•  LAST  MODIFIED:    29  MAY  87 

.    AUTHOR:  LCDR  PAUL  M.  HERZIG 

-    DESCRIPTION:    This  package  contains  the  analysis  functions 
required  to  identify  each  data  flow  in  the  Henry  metric. 

*************************************************************** 


with  GLOBAL,  GLOBAL   PARSER,  BYPASS  SUPPORTFUNCTIONS,  HENRYGLOBAL,  TEX' 
use   GLOBAL,  GLOBAL   PARSER,  BYPASSSUPPORTFUNCTIONS,  HENRY  GLOBAL,  TEXl 

package  HENRY   ANALYSIS  is 

package  NEW   INTEGER   10  is  new  TEXT  10. INTEGER  lO(integer); 
use  NEW   INTEGERIO; 

package  REALIO  is  new  TEXT_IO.FLOAT_IO(float); 
use  REALIO; 

PROCFUNCCOUNT  :  INTEGER  :=  0; 
INDEX  :  INTEGER; 

NAME  POINTER      :  POINTER; 

— PROC   FUNC   COUNT  is  the  total  number  of  procedures  and  functions  in  the 
—analyzed  package 


type  SELECTOR  TYPE  is  (PROCEDUREFIND,  FUNCTIONFIND, 

VARIABLE  FIND); 
procedure  CLEAN  UP   HENRY  DATA(HEAD  :  in  POINTER); 
procedure  SET  UP  HENRY   ARRAY(HEAD  :  in  POINTER; 
HEAD   LINE     :  in  LINE  POINTER); 

procedure  SPRUCE  UP   HENRY   DATA; 
function  LOCAL_NAME(NAME_POINTER      :  m  POINTER; 
SELECTOR  :  in  SELECTORTYPE; 

INDEX  :  in  INTEGER  ) 

return  BOOLEAN; 
function  CALCULATE  LINE  COUNT(WORK   LINE  :  LINE  POINTER) 

return  INTEGER; 
function  FIND_STRINGSIZE(IN   STRING  :  LEXEMETYPE)  RETURN  INTEGER; 
function  TRANSITIVITY_IN(IN_NAME  :  LEXEME  TYPE; 
BEGIN  LOOP,  STOP  LOOP  :  POINTER) 
RETURN  FLOAT; 
function  TRANSITIVITY  OUT(IN   NAME  :  LEXEMETYPE; 
TOP       :  POINTER) 
RETURN  FLOAT; 
procedure  CALCULATE_METRIC(HEAD  :  in  POINTER; 

HEAD  LINE     :  in  LINE  POINTER); 
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end  HENRY   ANALYSIS; 


package  body  HENRY   ANALYSIS  is 


—starts  the  process  of  setting  up  the  raw  Henry  records  into 
—decipherable  data,  it  also  counts  the  numbers  of  procedures 
—functions  and  fills  in  empty  parameter  type  fields  in  the 
—Henry  records 

procedure  CLEAN  UP  HENRY  DATA(HEAD  :  IN  POINTER)  is 

TEMP,  TOP,  BOTTOM  :  POINTER; 

begin 
put(HENRY_FILE,  "in  CLEANUPHENRY");  new_line(HENRY_FILE); 
CLEARSCREEN; 

put("Processing  Henry  data  records  ...  please  wait"); 
TOP       ■-  HEAD: 
BOTTOM   :=  TOP.NEXTl; 

—  move  past  package  declarations 

LOOP 

EXIT  WHEN  TOP. TYPE  DEFINE  =  ENDPACKAGEDECLARE; 

TOP      :=  BOTTOM; 

BOTTOM  :=  TOP.NEXTl; 
END  LOOP; 

—count  the  number  of  procedures/functions 

LOOP 

EXIT  WHEN  BOTTOM. TYPE  DEFINE  =  END  PACKAGE  TYPE; 
if  (BOTTOM. TYPE  DEFINE  =  PROCEDURE  TYPE)  or 
(BOTTOM. TYPE  DEFINE  =  FUNCTION  TYPE)  then 
PROCFUNC   COUNT  :=  PROCFUNC   COUNT  +  1; 
end  if; 

TEMP      :=  BOTTOM; 

BOTTOM  :=  TEMP.NEXTl; 
end  loop; 
BOTTOM  :=  TOP; 

—ensure  all  parameter  records  have  a  type  defined 

FOR  I  in  1..PR0C  FUNG  COUNT  LOOP 
LOOP 

EXIT  WHEN  (TOP.TYPE  DEFINE  =  PROCEDURE  TYPE)  OR 

(TOP. TYPE  DEFINE  =  FUNCTIONTYPE); 
TOP      :=  BOTTOM.NEXTl; 
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BOTTOM  :=  TOP; 
END  LOOP; 
TEMP  :=  TOP.NEXTl; 

if  TEMP. TYPE  DEFINE  =  PARAM  TYPE  AND 
TOP.TYPE  DEFINE  /-  FUNCTION  TYPE  then 
LOOP 
EXIT  WHEN  TEMP. TYPE  DEFINE  =  END  PARAM  DECLARE; 
if  TEMP. PARAM  TYPE  NOT  IN  FORMAL  PARAM  CLASS  THEN 
LOOP 
EXIT  WHEN  (TEMP, PARAM  TYPE  =  IN  TYPE)  OR 
(TEMP  PARAM  TYPE  =  OUT  TYPE)  OR 
(TEMP. PARAM  TYPE  =  INOUTTYPE); 
BOTTOM  :=  TEMP; 
TEMP  :=  BOTTOM.NEXTl; 
END  LOOP; 
BOTTOM  :=  TEMP; 
TEMP  :=  TOP.NEXTl; 
TOP   ~  TEMP; 
LOOP 
EXIT  WHEN  (TOP. PARAM  TYPE  =  IN  TYPE)  OR 
(TOP. PARAM  TYPE  =  OUT  TYPE)  OR 
(TOP. PARAM  TYPE  =  IN  OUT  TYPE); 
TEMP. PARAM  TYPE  :=  BOTTOM. PARAM  TYPE; 
TEMP  :=  TOP.NEXTl; 
TOP  :=  TEMP; 
END  LOOP; 
else 
TOP  :=  TEMP; 
BOTTOM  :=  TEMP; 
end  if; 

TEMP  :=  TOP.NEXTl; 
END  LOOP; 

—functions  usually  invoke  the  default  in   type  parameter 
—insert  this  type  if  it  is  not  defined 

elsif  TOP.TYPEDEFINE  =  FUNCTION  TYPE  THEN 
if  TEMP. TYPE  DEFINE  =  PARAM  TYPE  THEN 
LOOP 
EXIT  WHEN  TEMP. TYPE  DEFINE  =  END  PARAM  DECLARE; 
TEMP.PARAM  TYPE  :=  IN  TYPE; 
TEMP     :=  BOTTOM.NEXTl; 
BOTTOM  :=  TEMP; 
END  LOOP; 
end  if; 
end  if; 

TOP      :=  BOTTOM.NEXTl; 
BOTTOM  :=  TOP; 
END  LOOP;  -FOR  LOOP 
end  CLEAN  UP  HENRY  DATA; 
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—sets  up  the  Henry  data  records  to  mark  the  beginning  of  each 
—function  or  procedure,  it  also  ties  the  procedure  line  length 
—records  to  its  proper  procedure/function 

procedure  SET  UP  HENRY   ARRAY(HEAD  :  in  POINTER; 

HEADLINE     :  in  LINE  POINTER)  is 

WORK   LINE,  TEMP  LINE  :  LINE  POINTER; 
TEMP,  TOP,  BOTTOM      ;  POINTER; 

begin 
put(HENRY_FILE,  "in  SETUP   HENRY");  new_lme(HENRY_FILE); 
WORK  LINE  :=  HEAD  LINE.NEXTREC; 
TEMP   LINE  :=  WORK  LINE; 
BOTTOM  :=  HEAD; 
TOP      :=  BOTTOM; 

-GO  PAST  DECLARATIONS 

LOOP 

EXIT  WHEN  TOP.TYPE  DEFINE  =  ENDPACKAGEDECLARE; 

TOP      :=  BOTTOM. NEXTl; 

BOTTOM  :=  TOP; 
END  LOOP; 

—set  up  the  Henry  array  records  so  that  their  pointers  are  at  the 
—top  of  each  procedure  or  function 

FOR  I  in  1..PR0C  FUNG  COUNT  LOOP 
LOOP 

EXIT  WHEN  (TOP.TYPE  DEFINE  =  PROCEDURE  TYPE)  OR 

(TOP.TYPE  DEFINE  =  FUNCTION  TYPE); 
TOP   :=  BOTTOM. NEXTl; 
BOTTOM  :=  TOP; 
END  LOOP; 
HENRY  ARRAY(I).NAME  OF  DATA(1.. MAX  LINE  SIZE)  :  = 

TOP.NOMEN(l..MAX  LINE  SIZE); 
HENRY  ARRAY(I). BEGIN  POINTER  :=  TOP; 
LOOP 
EXIT  WHEN  (BOTTOM.TYPE  DEFINE  =  END  FUNCTION  TYPE)  OR 

(BOTTOM.TYPE  DEFINE  =  END  PROCEDURE  CALL); 
TEMP   :=  BOTTOM. NEXTl; 
BOTTOM  :=  TEMP; 
END  LOOP; 

—set  the  line  count  records  to  their  related  procedure/function 

TOP      :-  BOTTOM.NEXTl; 

BOTTOM  :=  TOP; 

HENRY   ARRAY(I). LINE  LENGTH  POINTER  :=  WORK  LINE; 

WORK   LINE  :=  TEMP  LINE.NEXT  REC; 

TEMP  LINE  :=  WORKLINE; 
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END  LOOP;  --FOR  LOOP 
end  SET  UP  HENRY  ARRAY; 


—this  procedure  calculates  the  length  of  each  procedure/function 
—the  results  are  fed  into  linelength  records 

function  CALCULATE  LINE  COUNT(WORK  LINE  :  LINE  POINTER) 

return  INTEGER  is 

DIFFERENCE  :  INTEGER  :=  0; 
I  :  INTEGER; 

begin 

put(HENRY  FILE,  "in  CALCULATELINE  COUNT");  new   line(HENRY_FILE); 

DIFFERENCE  :=  WORK  LINE.STOP  COUNT  -  WORKLINE.STARTCOUNT; 

RETURN  (DIFFERENCE); 
end  CALCULATE  LINE  COUNT; 


—this  function  searches  for  local,  within  a  procedure,  and  global-local, 

—within  a  package,  for  variable  name  matches 

—  it  is  selectable  for  which  name  the  search  is  conducted 

function  LOCAL  NAME(NAME  POINTER      :  in  POINTER; 
SELECTOR  :  in  SELECTOR   TYPE; 

INDEX  :  in  INTEGER  ) 

return  BOOLEAN  is 

NAME  SOUGHT,  POINTER  NAME   :  LEXEME  TYPE; 
NAME  SIZE,  POINTER   SIZE  :  INTEGER  :=  MAXLINESIZE; 
RESULT  :  BOOLEAN  :=  FALSE; 

TEMP,  TEMPI  :  POINTER; 

I  :  INTEGER  :-  1; 

begin 

put(HENRY   FILE,  "in  LOCAL   NAME");  newJine(HENRY  FILE); 

NAME  S0UGHT(1.. NAME  SIZE)  :=  NAME  POINTER. NOMEN(l.. NAME  SIZE); 

CONVERT_UPPER_CASE{NAME_SOUGHT,  NAMESIZE); 


if  ((SELECTOR  =  PROCEDUREFIND)  OR  (SELECTOR  =  FUNCTIONFIND)) 
AND  (PROCFUNCCOUNT  /=  0)  then 
LOOP 

POINTER  NAME(1.. POINTER  SIZE)  :  = 

HENRY   ARRAY(I). NAME  OF  DATA(1.. POINTER  SIZE); 

CONVERT  UPPER  CASE(POINTER  NAME,  POINTER   SIZE); 

RESULT  :=  (NAME  SOUGHT(l.. NAME  SIZE)  = 
POINTER  NAME(1.. POINTER   SIZE)); 

EXIT  WHEN  (I  =  PROCFUNC  COUNT)  OR  (RESULT); 

I:=  I  +  1; 
END  LOOP; 
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I:=l; 

—if  it  is  a  variable  name  search  first  within  the  package 
—declarations,  next  within  the  procedure  declarations 

elsif  SELECTOR  =  VARIABLE  FIND  then 
TEMP  :=  HEAD.NEXTl; 
LOOP 
EXIT  WHEN  (TEMP. TYPE  DEFINE  =  END   PACKAGE  DECLARE)  OR 

(RESULT); 
if  TEMP.TYPEDEFINE  =  IDENT  TYPE  then 
POINTER  NAME(1.. POINTER  SIZE)  :=  TEMP.NOMEN(l.. POINTER  SIZE); 
CONVERTUPPER  CASE(POINTER  NAME,  POINTERSIZE); 
RESULT  :=  (NAME  SOUGHT(l.. NAME  SIZE)  = 
POINTER  NAME(1.. POINTER  SIZE)); 
end  if; 

TEMPI  :=  TEMP.NEXTl; 
TEMP    :=  TEMPI; 
END  LOOP; 

—did  not  find  the  variable  within  the  package  declarations 
—search  the  specified  procedures  declarations 

if  NOT  RESULT  then 
TEMP  :=  HENRY   ARRAY(INDEX). BEGIN  POINTER; 
LOOP      -  DID  NOT  FIND  NAME  IN  PACKAGE  DECLARATIONS 
EXIT  WHEN  (TEMP. TYPE  DEFINE  =  END   DECLARATIONS)  OR 

(RESULT); 
if  TEMP. TYPE  DEFINE  =  IDENT  TYPE  then 
POINTER  NAME(1.. POINTER  SIZE)  :  = 
TEMP. N0MEN(1.. POINTER   SIZE); 
CONVERT  UPPER  CASE(POINTER  NAME,  POINTER  SIZE); 
RESULT  :=  (NAME  S0UGHT(1..NAME_SIZE)  = 
POINTER  NAME(1..P0INTER_SIZE)); 
end  if; 

TEMPI  :=  TEMP.NEXTl; 
TEMP    :=  TEMPI; 
END  LOOP; 
end  if; 
end  if; 

RETURN  (RESULT); 
end  LOCAL   NAME; 


—finishes  polishing  the  Henry  records,  the  data  can  now  be  analyzed 
—for  local/global  data  and  starts  the  actual  number  crunching 


procedure  SPRUCE  UP  HENRY  DATA  is 
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TEMP,  TEMPI,  TEMP2  :  POINTER; 


begin 
put(HENRY_FILE,  "in  SPRUCEUPHENRY");  new   line(HENRY   FILE); 
FOR  I  in  l.-PROCFUNC  COUNT  LOOP 
TEMPI  :-  HENRY   ARRAY(I). BEGIN  POINTER; 

—loop  past  parameters 

LOOP 

EXIT  WHEN  TEMPI. TYPE  DEFINE  =  ENDDECLARATIONS; 

TEMP2  :=  TEMPI. NEXTl; 

TEMPI  ~  TEMP2; 
END  LOOP; 
TEMP  :=  TEMPI. NEXTl; 

—first  analyze  identifier  types  (variables)  for  local  or  global 
—significance.  Update  the  record  if  it  is  not  local 

LOOP   -LOOK  FOR  IDENT  TYPES 
EXIT  WHEN  (TEMP. TYPE  DEFINE  =  END  FUNCTION  TYPE)  OR 

(TEMP. TYPE  DEFINE  =  END   PROCEDURE  CALL); 
if  TEMP. TYPE  DEFINE  =  IDENT  TYPE  then 
if  TEMP. IDENTITY  =  BLANK  then 
if  LOCAL   NAME(TEMP,  VARIABLE  FIND,  I)  then 

TEMP. IDENTITY  :=  LOCAL   DECLARE; 
else  TEMP. IDENTITY  :=  GLOBAL   DECLARE; 
end  if; 
end  if: 
end  if; 

TEMPI  .=  TEMP.NEXTl; 
TEMP   :=  TEMPI; 

END  LOOP: 

—now  go  through  the  Henry  records  looking  for  unresolved 

—procedure  or  function  calls  update  the  Henry  records 

—to  reflect  procedure  types  or  function  types  or  data  structures 


TEMPI  :=  HENRY_ARRAY(I). BEGIN  POINTER; 
TEMP    :=  TEMPI. NEXTl; 

—get  past  declarations 

LOOP 

EXIT  WHEN  TEMP.TYPEDEFINE  =  ENDDECLARATIONS; 

TEMPI  :=  TEMP.NEXTl; 

TEMP    :=  TEMPI; 
END  LOOP; 
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—looking  for  procedure  or  function  calls 

LOOP 

EXIT  WHEN  (TEMP.TYPE  DEFINE  =  END   FUNCTION  TYPE)  OR 
(TEMP.TYPE  DEFINE  =  END   PROCEDURECALL); 

if  TEMP.TYPE  DEFINE  =  PROCALL   OR  DS  then 
TEMPI  :=  TEMP; 
LOOP  -  MOVE  PAST  THE  PARAMETERS 

EXIT  WHEN  TEMPI. TYPE  DEFINE  =  END   ACTUAL   PARAM; 
TEMP2  :=  TEMPI; 
TEMPI  :=  TEMP2.NEXTI; 
END  LOOP; 
if  (LOCAL  NAME(TEMP,  PROCEDURE  FIND,  I))  then 

TEMP.TYPE  DEFINE  :=  PROCEDURETYPE; 
else 

TEMP2  :=  TEMPI. NEXTl; 

if  TEMP2. TYPE  DEFINE  -  ASSIGN  TYPE  then 
TEMP.TYPE  DEFINE  :=  DATA   STRUCTURE; 
-IF  NOT  IT  IS  A  PROCEDURE  CALL  ONLY 
TEMPI  :=  TEMP2. NEXTl; 
LOOP 

EXIT  WHEN  TEMPI. TYPE  DEFINE  -  END   ASSIGN  TYPE; 
if  (TEMPI. TYPE  DEFINE  =  FUNCALLOR  DS)  then 
if  NOT  LOCAL   NAME(TEMP1,  FUNCTION  FIND,  I) 
then 

TEMPI. TYPEDEFINE  :=  DATA  STRUCTURE; 
else  TEMPI. TYPEDEFINE  :=  FUNCTION  TYPE; 
end  if; 
end  if; 

TEMP2  :=  TEMPI; 
TEMPI  :=  TEMP2. NEXTl; 
END  LOOP; 
else  TEMP.TYPE  DEFINE  :=  PROCEDURE  TYPE; 
end  if; 
end  if; 

—only  function  calls  that  cannot  be  resolved  into  a  local  name  are 
—specified  as  data  structures 

elsif  TEMP.TYPE  DEFINE  =  FUNCALL  OR  DS  then 
TEMPI  —  TEMP; 

LOOP       -LOOKING  FOR  FUNCTIONS 

EXIT  WHEN  TEMP.TYPE  DEFINE  =  END   ASSIGN  TYPE; 
if  TEMP.TYPE  DEFINE  =  FUNCALL  OR  DS  then 
if  (LOCAL  NAME(TEMP,  FUNCTIONFIND,  I)) 
then 

TEMP.TYPE  DEFINE     :=  FUNCTION  TYPE; 
else  TEMP.TYPE  DEFINE  :=  DATA   STRUCTURE; 
end  if; 
end  if; 
TEMPI  :=  TEMP. NEXTl; 
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TEMP  :-  TEMPI; 
END  LOOP; 
end  if; 

TEMPI  :=  TEMP; 
TEMP  :=  TEMPI. NEXTl; 
END  LOOP;  -PROCALL  OR  DS  LOOP 
END  LOOP;  --  FOR  LOOP 


end  SPRUCE  UP  HENRY  DATA; 

—this  function  only  works  for  Ada  language  strings  that  identify 
—a  variable 

function  FIND_STRINGSIZE(IN  STRING  :  LEXEMETYPE)  RETURN  INTEGER 

is 

SIZE  :  INTEGER  :-  0; 

BEGIN 

PUT(HENRY  FILE,  "IN  FIND  STRING  SIZE");  NEW_LINE(HENRY_FILE); 
FOR  I  IN  1.  MAX  LINE  SIZE  LOOP 
IF  IN  STRING(I)  /=  NULL   CHAR  THEN 

SIZE  :=  SIZE  +  1; 
END  IF; 
END  LOOP; 
RETURN  SIZE; 
END  FIND  STRING   SIZE; 


—transitivity    is  detected  by  searching  the  right  hand  side  of 
—  assignment  statements  for  a  name  match  of  the  actual 
—parameters  from  a  function  or  procedure  call 

function  TRANSITIVITY  IN(IN  NAME  :  LEXEME  TYPE; 
BEGIN  LOOP,  STOP  LOOP  :  POINTER) 
RETURN  FLOAT  is 

ASSIGN  MARK, 

PROCEDURE  MARK  :  BOOLEAN  :=  FALSE; 

TRANS   COUNT      :  FLOAT     :=  0.0; 

TEMP,  TEMPI      :  POINTER  :=  BEGIN   LOOP; 

Tl,  T2  :  POINTER: 

MAX  :  INTEGER  :=  MAX  LINE  SIZE; 

BEGIN 

—stop  loop  is  determined  by  where  in  the  parameter  list  you  are 

LOOP 
EXIT  WHEN  TEMP  -  STOP  LOOP; 
if  TEMP.TYPE  DEFINE  =  ASSIGN  TYPE  THEN 
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ASSIGN   MARK  :=  TRUE; 
elsif  TEMP. TYPE  DEFINE  =  END   ASSIGN  TYPE  THEN 

ASSIGNMARK  ;=  FALSE; 
end  if; 

—mark  whether  you've  passed  an  assignment 

if  (TEMP.N0MEN(1..MAX)  =  IN_NAME(1..MAX))  AND 
(NOT  ASSIGNMARK)  THEN 
TRANS  COUNT  :=  TRANS  COUNT  +  1.0; 

—if  you  have  detected  a  name  match  count  the  number  of  assignment 
—variables  as  transitive  feed  into  the  actual  parameter 
—note  functions  have  already  been  calculated  the  same  for 
—data  structures  so  skip  these  counts 

Tl  :=  TEMP;  T2  :=  Tl.NEXTl; 
if  (Tl. TYPE  DEFINE  =  IDENT  TYPE)  AND 
(T2.TYPE_DEFINE  =  ASSIGN  TYPE)    then 
LOOP 

EXIT  WHEN  T2. TYPE  DEFINE  =  ENDASSIGN  TYPE; 
if  T2. TYPE  DEFINE  =  IDENT  TYPE  THEN 

TRANS  COUNT  ;=  TRANSCOUNT  +  1.0; 
end  if; 
Tl  :=  T2; 
T2  :=  Tl.NEXTl; 
END  LOOP; 
end  if; 
end  if; 

TEMP    :=  TEMPI. NEXTl; 
TEMPI  :-  TEMP; 
END  LOOP; 

RETURN(TRANS_COUNT); 
END  TRANSITIVITY  IN; 


—if  detect  a  name  match  on  the  right  hand  side  of  an  assignment 
—statement  have  a  transitive  relation  on  this  variable  but 
—there  is  no  need  to  count  the  rest  of  the  assignment 
—variables  becuase  the  most  it  can  account  for  is  1 

function  TRANSITIVITY  OUT(IN   NAME  :  LEXEME  TYPE; 
TOP       :  POINTER) 
RETURN  FLOAT  is 

ASSIGN   MARK  :  BOOLEAN  :=  FALSE; 
TRANSCOUNT  :  FLOAT     :=  0.0; 
TEMP,  TEMPI  :  POINTER  :=  TOP; 
MAX  :  INTEGER  :=  MAX  LINE  SIZE; 
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BEGIN 
LOOP 
EXIT  WHEN  (TEMP. TYPE  DEFINE  =  END  PROCEDURE  CALL)  OR 

(TEMP. TYPE  DEFINE  =  END  FUNCTION  TYPE); 
IF  TEMP.TYPEDEFINE  =  ASSIGN  TYPE  THEN 

ASSIGN  MARK  :-  TRUE; 
ELSIF  TEMP. TYPE  DEFINE  =  END   ASSIGN  TYPE  THEN 

ASSIGN  MARK  :-  FALSE; 
END  IF; 

IF  (TEMP.NOMEN(l..MAX)  =  IN  NAME(1..MAX))  AND  (ASSIGN  MARK) 
THEN 

TRANS   COUNT  :-  TRANSCOUNT  +  1.0; 
END  IF; 

TEMP    :=  TEMPI. NEXTl; 
TEMPI  :=  TEMP; 
END  LOOP; 

RETURN(TRANS  COUNT); 
END  TRANSITIVITY  OUT; 


—finishes  polishing  the  data  and  with  the  transitivity  functions  calculates 
—the  fan  in  /fan  out  of  data  besides  the  global  data  structures 

procedure  CALCULATE  METRIC  (HEAD  ;  in  POINTER; 

HEAD  LINE     :  in  LINE  POINTER)  is 

TEMP   LINE  :  LINE  POINTER; 

TEMP,  TOP,  TEMPI,  TEMP2  :  POINTER; 
PROC  PTR, 
PARAM  PTR  :  POINTER; 

FAN  IN,  FAN  OUT  :  FLOAT; 

LENGTH  :  INTEGER  ;=  0; 

MAX  :  INTEGER  :=  MAX   LINE  SIZE; 

CODE   EXPONENT  ;  INTEGER  :=  2; 

COMPLEXITY, 

GLOBAL  FLOW, 

GLOBAL  READ, 

GLOBAL   WRITE, 

GLOBAL   READ   WRITE  ;  FLOAT; 

—global  flow  represents  the  whole  picture  of  global  data  flow 
—the  equation  is  below  and  encompasses  both  read  and  write  to 
—global  data  structures 

—note:  global  data  structures  could  be  external  function  calls 
—there  is  no  means  to  determine  the  difference 

NEW   NAME  :  STRING(l   MAX  LINESIZE); 

NAME  OF  :  LEXEME  TYPE; 

ASSIGN  MARK, 

GLOBAL   MARK  :  BOOLEAN  :=  FALSE; 
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SIZE  :  INTEGER  ~  MAX   LINE  SIZE; 

NEW   SIZE  :  INTEGER  :=  0; 

TEMPNAME  :  STRING(1..SIZE); 

begin 
PUT(HENRY_FILE,  "IN  CALCUALTE  METRIC");  NEW_LINE(HENRY  FILE); 


—first  Henry  call  boolean  is  so  that  the  data  can  be  reshown 

IF  FIRST  HENRY  CALL  then 
CLEAN   UP  HENRY  DATA(HEAD); 
SET  UP  HENRY  ARRAY(HEAD,  HEAD  LINE); 
SPRUCE  UP  HENRY  DATA; 
FOR  I  in  1..PR0CFUNC  COUNT  LOOP 

GLOBAL   READ  :=  0.0; 

GLOBALWRITE         :=  0.0; 

GLOBAL   READWRITE  :=  0.0; 

FAN   IN  :=  0.0; 

FAN   OUT  :=  0.0; 

COMPLEXITY  :=  0.0; 

GLOBALFLOW  ■-  0.0; 

LENGTH  :=  0; 

TEMP  :=  HENRY  ARRAY(I). BEGIN  POINTER; 

CLEAR  HENRY  LEXEME(TEMP  NAME); 

TEMP  NAME(1.. MAX  LINE  SIZE)  :=  HENRY  ARRAY(I). NAME  OF  DATA; 

SIZE      :=  FIND  STRING   SIZE(TEMP  NAME); 

CLEAR  HENRY  LEXEME(NEW   NAME); 

CONVERT  UPPER  CASE(TEMP  NAME,  SIZE); 

—initialize  the  variables  for  each  loop  on  either  function  or  procedure 
—calculations 

if  TEMP.TYPE  DEFINE  =  PROCEDURE  TYPE  then 

OUT  PUT  DATA(I).TYPE  OF    :=  PROCEDURE  TYPE; 

NEW   SIZE  :=  SIZE  +  10; 

NEW_NAME(1..10)  :=  "procedure  "; 

NEW   NAME(11. NEW   SIZE)     :=    TEMP  NAME(1.. SIZE); 

OUT  PUT  DATA(I). NAME  0F(1.. NEW  SIZE)  :=  NEW_NAME(1..NEW_SIZE); 

PUT  ( HENR  YOUT,  " " ) ; 

NEW   LINE(HENRY  OUT,  2); 

PUT(HENRY  OUT,  NEW   NAME); 

NEW   LINE(HENRY  OUT); 
elsif  TEMP.TYPE  DEFINE  =  FUNCTION  TYPE  then 

OUT  PUT_DATA(I).TYPE_OF     :=  FUNCTIONTYPE; 

NEW   SIZE  :=  SIZE  +  9; 

NEW_NAME(1..9)  :=  "function  "; 

NEW   NAME(10.. NEW   SIZE)  :=    TEMP  NAME(l.. SIZE); 

OUT  PUT  DATA(I). NAME  OF(l.. NEW  SIZE)  :=  NEW  NAME(1.. NEW   SIZE); 

PUT(HENRY  OUT,  " "); 

NEW   LINE(HENRY  OUT,  2); 

PUT(HENRY  OUT,  NEWNAME); 
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NEW_LINE(HENRY  OUT); 

end  if; 

—constructs  a  pretty  name  for  the  data  file 

TEMPI  :=  TEMP.NEXTl; 
TEMP2  :=  TEMPI; 

—  look  for  global  variables;  increase  global  flow  metric 

LOOP 
EXIT  WHEN  (TEMPI. TYPE  DEFINE  =  END  FUNCTION  TYPE)  OR 

(TEMPI. TYPE  DEFINE  -  END  PROCEDURE  CALL); 
if  TEMPI. TYPEDEFINE  =  ASSIGN  TYPE  then 

ASSIGN  MARKER  :=  TRUE; 
elsif  TEMPI. TYPE  DEFINE  =  ENDASSIGNTYPE  then 
ASSIGN   MARKER  :=  FALSE; 
GLOBAL   MARKER  :=  FALSE; 
end  if; 

if  (TEMPI  IDENTITY  =  GLOBALDECLARE)  AND  (ASSIGNMARKER) 
then 

GLOBAL   READ  :=  GLOBAL   READ  +  1.0; 
if  GLOBAL   MARKER  then 

GLOBAL   READ  WRITE  :=  GLOBAL   READ   WRITE  +  1.0; 
end  if; 
elsif  (TEMPI. IDENTITY  =  GLOBALDECLARE)  AND 
(NOT  ASSIGNMARKER)  then 
GLOBAL   WRITE  ~  GLOBAL   WRITE  +  1.0; 
GLOBAL   MARKER  :=  TRUE; 
end  if; 

TEMPI  :-  TEMP2.NEXT1; 
TEMP2  :=  TEMPI; 
END  LOOP; 

~  calculate  next  level  of  data  flow;  procedure  formal  parameters 

TEMPI  :-  TEMP.NEXTl; 

if  TEMPI. TYPE  DEFINE  =  PARAM  TYPE  then 
LOOP 
EXIT  WHEN  TEMPI. TYPE  DEFINE  =  END  PARAMDECLARE; 
if  TEMPI. PARAM  TYPE  =  IN  TYPE  THEN 

FAN  IN  :=  FANIN  +  1.0; 
elsif  TEMPI. PARAM  TYPE  =  OUT  TYPE  THEN 

FAN  OUT  :=  FAN  OUT  +  1.0; 
elsif  TEMPI. PARAM  TYPE  =  INOUTTYPE  THEN 
FANJN   :=  FANJN  +  1.0; 
FAN  OUT  :=  FAN  OUT  +  1.0; 
end  if; 

TEMP    :=  TEMPI; 
TEMPI  :=  TEMP.NEXTl; 
END  LOOP; 
end  if; 
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—look  for  procedure  and  function  type  actual  parameters 

TEMP    :=  TEMPI; 
TEMPI  :=  TEMP.NEXTl; 
TEMP    :=  TEMPI; 
LOOP 
EXIT  WHEN  (TEMP  TYPE  DEFINE  =  ENDFUNCTION  TYPE)  OR 
(TEMP  TYPE  DEFINE  =  END  PROCEDURECALL); 

TEMPI  :=  TEMP; 

TEMP    :=  TEMPI. NEXTl; 

if  TEMP.TYPE  DEFINE  =  ASSIGN  TYPE  then 

ASSIGN  MARKER  :-  TRUE; 
elsif  TEMP.TYPE  DEFINE  =  END   ASSIGN  TYPE  then 
ASSIGN  MARKER  ;=  FALSE; 
GLOBAL  MARKER  :=  FALSE; 
end  if; 

if  TEMP.TYPE  DEFINE  =  PROCEDURETYPE  then 
TEMPI  :-  TEMP.NEXTl; 
LOOP 
EXIT  WHEN  TEMPI. TYPE  DEFINE  =  ENDACTUALPARAM; 
FANOUT  :=  FAN  OUT  +  1.0; 
TEMP2  :=  TEMPI; 
TEMPI  :=  TEMP2. NEXTl; 
END  LOOP; 
elsif  TEMP.TYPE  DEFINE  =  FUNCTION  TYPE  THEN 

~  count  the  function  parameters 

TEMPI  :=  TEMP.NEXTl; 
LOOP 

EXIT  WHEN  TEMPI. TYPE  DEFINE  =  END   ACTUAL  PAR  AM; 

FAN  OUT  :=  FAN  OUT  +  1.0; 

TEMP2  :=  TEMPI; 

TEMPI  :=  TEMP2. NEXTl; 
END  LOOP; 

FANIN  :=  FAN  IN  +  1.0;   -RETURN  FROM  FUNCTION 
elsif  (TEMP.TYPE  DEFINE  =  DATA  STRUCTURE)  and 

(NOT  ASSIGNMARK)  THEN 
GLOBAL  MARK  :=  TRUE; 
GLOBAL   WRITE  ~  GLOBAL   WRITE  +  1.0; 
elsif  (TEMP.TYPE  DEFINE  =  DATA  STRUCTURE)  and  ASSIGN  MARK 

THEN 
if  GLOBAL   MARK  THEN 

GLOBAL   READ   WRITE  :=  GLOBAL  READ   WRITE  +  1.0; 
elsif  NOT  GLOBAL  MARK  THEN 

GLOBAL   READ  :=  GLOBAL   READ  +  10; 
end  if; 
end  if; 
END  LOOP; 
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—now  check  for  transitivity  in  the  actual  parameters 

TOP  :=  HEAD.NEXTl; 
TEMP  :=  TOP; 
LOOP 

EXIT  WHEN  TOP. TYPE  DEFINE  =  END  PACKAGE  DECLARE; 
TOP  :=  TEMP.NEXTl; 
TEMP  :=  TOP; 
END  LOOP; 

FOR  I  IN  1..PR0CFUNC  COUNT  LOOP 
TEMP  :=  HENRY  ARRAY(I). BEGIN  POINTER; 
PROCPTR  :=  TEMP.NEXTl; 
TEMP   :=  PROC  PTR; 
LOOP 
LOOP 
EXIT  WHEN  (PROC  PTR. TYPEDEFINE  =  PROCEDURE  TYPE)  OR 
(PROC  PTR.TYPE  DEFINE  =  FUNCTION  TYPE)  OR 
(PROC  PTR.TYPE  DEFINE  =  END  PROCEDURECALL)  OR 
(PROCPTR. TYPE  DEFINE  =  ENDFUNCTIONTYPE); 
PROC  PTR  :=  TEMP.NEXTl; 
TEMP  :=  PROC  PTR; 
END  LOOP; 

IF  (PROC  PTR.TYPE  DEFINE  /=  END  PROCEDURE  CALL)  AND 
(PROC  PTR.TYPE  DEFINE  /=  END  FUNCTION  TYPE)  THEN 
PARAM  PTR  :=  PROC  PTR. NEXTl; 
LOOP 
EXIT  WHEN  PARAM  PTR.TYPE  DEFINE  =  END  ACTUAL  PARAM; 
NAME  0F(1.. MAX)  :=  PARAM  PTR. N0MEN(1.. MAX); 
FAN  IN  :=  FAN  IN  +  TRANSITIVITY  IN(NAME  OF, 

TOP,  PROC  PTR); 
FAN  OUT  :=  FAN  OUT  +  TRANSITIVITY_OUT(NAME_OF, 

PARAM  PTR); 
TEMP  ;=  PARAM  PTR; 
PARAM  PTR  :-  TEMP.NEXTl; 
END  LOOP; 
END  IF; 
EXIT  WHEN  (PROC  PTR.TYPE  DEFINE  =  END  PROCEDURE  CALL)  OR 
(PROC  PTR.TYPE  DEFINE  =  END  FUNCTIONTYPE)  OR 
(PROC  PTR  TYPE  DEFINE  =  END  PACKAGE  TYPE); 
PROC  PTR  —  PARAM  PTR. NEXTl; 
TEMP   :-  PROC  PTR; 
END  LOOP; 
END  LOOP;  -FOR  LOOP 


-NOW  CALCULATE  ALL  THE  NUMBERS  AND  STORE  IN  OUTPUT  FILE 

LENGTH    :  = 

CALCULATE  LINE  COUNT(HENRYARRAY(I).LINE_LENGTH_POINTER); 

COMPLEXITY   :-  float(LENGTH)  * 

(FANIN  *  FANOUT)  **  CODE  EXPONENT; 
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GLOBAL  FLOW  :=  GLOBAL  WRITE  * 

(GLOBAL  READ  +  GLOBAL  READ  WRITE)  + 

GLOBAL  READ  WRITE  * 

(GLOBAL  READ  +  GLOBAL  READ  VVRITE  -  1.0); 

put(HENRY  OUT,  "NUMBER  OF  LINES  =   "); 

put(HENRY  OUT,  LENGTH); 

OUT  PUT  DATA(I). CODE  LENGTH     :=  LENGTH; 

NEW  LINE(HENRY_OUT); 

put(HENRY  OUT,  "FAN  IN  =      "); 

put(HENRY  OUT,  FANIN); 

OUT  PUT  DATA(I).TYPE  FAN  IN     :=  FAN  IN; 

NEW  LINE(HENRY  OUT); 

put(HENRY_OUT,  "FAN  OUT  =      "); 

put(HENRY   OUT,  FAN  OUT); 

OUT   PUT   DATA(I). TYPE  FAN  OUT  :=  FAN  OUT; 

NEW   LINE(HENRY  OUT); 

put(HENRY_OUT,  "COMPLEXITY  =  "); 

putJHENRY  OUT,  COMPLEXITY); 

OUT_PUTDATA(I).TYPE  COMPLEXITY      :=  COMPLEXITY; 

NEW_LINE(HENRY  OUT); 

put(HENRY_OUT,  "GLOBAL  READ  =  "); 

put(HENRY   OUT,    GLOBAL   READ); 

OUT  PUT   DATA(I). TYPE  READ  :=  GLOBAL   READ; 

NEW   LINE(HENRY   OUT); 

put(HENRY   OUT,  "GLOBAL  WRITE  =         "); 

put(HENRY  OUT,  GLOBAL   WRITE); 

OUT   PUT   DATA(I). TYPE   WRITE  :=  GLOBALWRITE; 

NEW   LINE(HENRY  OUT); 

put(HENRY_OUT,  "GLOBAL  READ  WRITE  =  "); 

put(HENRY  OUT,  GLOBALREAD  WRITE); 

OUT  PUT  DATA(I). TYPE  READ   WRITE        :=  GLOBAL   READ   WRITE; 

NEW  LINE(HENRY  OUT); 

put(HENRY   OUT,  "GLOBAL  FLOW  =  "); 

put(HENRY  OUT,  GLOBAL   FLOW); 

OUT  PUT  DATA(I). TYPE  FLOW  :=  GLOBAL  FLOW; 

NEW   LINE(HENRY  OUT,  2); 

END  LOOP; 

PUT(HENRY  OUT,  " - - "); 

end  if;    --FIRST   HENRY  CALL; 
FIRST   HENRY  CALL  :=  FALSE; 
END  CALCULATE  METRIC; 
END  HENRY   ANALYSIS; 


-   TITLE:  AN  ADA  SOFTWARE  METRIC 
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-  MODULE  NAME:      PACKAGE  HENRY  DISPLAY 

-  DATE  CREATED:     04  MAY  87 

-  LAST  MODIFIED:    31  MAY  87 

-  AUTHOR:  LCDR  PAUL  M.  HERZIG 

~    DESCRIPTION:    This  package  contains  the  display  functions. 

*************************************************************** 

with  GLOBAL,  GLOBAL  PARSER,  HENRY  GLOBAL,  HENRY   ANALYSIS,  TERM  10, 

TEXT  10; 
use   GLOBAL,  GLOBALPARSER,  HENRY  GLOBAL,  HENRY  ANALYSIS,  TERMIO, 

TEXT  10; 

package  HENRY  DISPLAY  is 

package  NEW   INTEGERIO  is  new  TEXT_IO.INTEGER_IO(integer); 
use  NEW   INTEGER   10; 

package  REALJO  is  new  TEXT_IO.FLOAT_IO(float); 
use  REAL   10; 

type  RELATIVEARRAY  is  array  (1  ..MAX   ARRAYSIZE)  of  OUTPUTDATA; 
subtype  ROW  STRING   TYPE  is  STRING(l..30); 

—relative  array  is  the  temporary  storage  for  the  calcualtions 
—that  compare  like  numbers  such  as  fan   in  of 
—procedure  1  to  fan   in  of  procedure  2 

MAX  FAN  IN  :  INTEGER  :=  1; 

MAX  FAN  OUT  :  INTEGER  :=  1; 

MAX  COMPLEXITY         :  INTEGER  :=  1; 
MAX   READ  :  INTEGER  :=  1; 

MAX   WRITE  :  INTEGER  :=  1; 

MAX   READ   WRITE        :  INTEGER  :=  1; 
MAX   FLOW  :  INTEGER  :=  1; 

REL   FAN   IN  :  FLOAT; 

REL   FAN  OUT  :  FLOAT; 

REL   COMPLEXITY        :  FLOAT; 
REL   READ  : FLOAT; 

REL   WRITE  :  FLOAT; 

REL   READ   WRITE        :  FLOAT; 
REL   FLOW  :  FLOAT; 

REL   ARRAY  :  RELATIVE  ARRAY; 

STRING   SIZE  :  INTEGER; 


procedure  VIEW   HENRY(SELECTOR  :  in  integer); 
procedure  LIST  HENRY  DATA; 
procedure  LISTMETRIC   DATA; 
procedure  WRITE  RELATIVEDATA; 
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procedure  GRAPH   RELATIVE  DATA; 

procedure  PAUSE  PRINT(STOP  COUNT  :  in  INTEGER; 

RUNNINGCOUNT  :  in  out  INTEGER; 

DONE  :  in  out  BOOLEAN); 
procedure  SET   UP   SCREEN(IN   STRING  :  in  ROW   STRING   TYPE; 
STRING   SIZE  :  in  INTEGER); 

procedure  CENTER   STRING(NAME  :  in  ROW   STRINGTYPE; 

IN   ROW,  WIDTH  :  in  integer); 
end  HENRY   DISPLAY; 


package  body  HENRY   DISPLAY  is 


—Pause  print  stops  the  printing  of  long  lists  so  that  the  viewer 
—can  peruse  the  results  without  losing  valuable  data.  It  also 
—returns  boolean  done  plus  integer  count 

procedure  PAUSE  PRINT(STOP_COUNT  :  in  INTEGER; 
RUNNING   COUNT  :  in  out  INTEGER; 
DONE  :  in  out  BOOLEAN)  is 

CH  :  CHARACTER  :=  'd'; 
COL,  ROW     :  INTEGER; 

begin 
if  STOP  COUNT  =  RUNNING   COUNT  then 

RUNNINGCOUNT  :=  0; 

NEW  LINE; 
PUT("  —  (Q)uit  or  strike  any  other  letter  to  continue  —  "); 

NEW  LINE; 

get(CH); 

DONE  :=  FALSE; 

DONE  -  ((CH  =  'Q')  OR  (CH  =  'q')); 

MOVE  CURSOR  LT(1);  MOVE  CURSOR  UP(l);  CLEAR  CURSOR  TO  EOL; 

MOVE  CURSOR  UP(1); 

CLEARCURSOR  TO  EOL, 
else  RUNNINGCOUNT  :=  RUNNING   COUNT  +  1; 
end  if; 

end  PAUSE  PRINT; 


-Centers  the  input  string  to  the  visible  screen  of  a  VT  100 

procedure  CENTER _STRING(NAME  :  in  ROW   STRING   TYPE; 
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IN  ROW,  WIDTH  :  in  INTEGER)  is 


SCREEN   WIDTH  :  INTEGER  :=  76; 
CENTER   POS     :  INTEGER  :=  0; 
TEMPNAME      .  ROWSTRINGTYPE; 

begin 

FOR  I  IN  1.30  LOOP 
TEMP  NAME(I)  ~  NULLCHAR; 

END  LOOP; 

TEMP  NAME(1.. WIDTH)  :=  NAME(1.. WIDTH). 

CENTER   POS  :=  SCREENWIDTH  /  2  -  WIDTH  /  2; 

SET  CURSOR  POS(CENTER_POS,  IN  ROW); 

PUT(TEMP_NAME); 

NEW   LINE; 
end  CENTER  STRING; 


-Puts  the  header  of  each  data  screen  up  with  an  underline  to  set  it 
—off  from  the  data 

procedure  SET  UP  SCREEN(IN  STRING  :  in  ROW   STRINGTYPE; 
STRING   SIZE  :  in  INTEGER)  is 

begin 

CLEARSCREEN; 

SET_REVERSE(ON); 

CENTER   STRING  (INSTRING,  1,  STRINGSIZE); 

SET   REVERSE(OFF); 
PUT(" — - "); 

NEW_LINE(2); 
END  SET  UP  SCREEN; 


—lists  the  entire  record  stream  of  the  Henry  metric  data 
procedure  LIST  HENRY   DATA  is 


SHORTNAME   SIZE  :  constant  integer  :=  40; 

TEMP  POINTER,  Tl    :  POINTER  :=  HEAD; 

TEMP  NAME       :  LEXEME  TYPE; 

SHORT  NAME       :  STRING(1..SH0RT_NAME_SIZE); 

SIZE  :  INTEGER  :=  0; 

RUNNING   COUNT  :  INTEGER  :=  1; 

STOP  :  INTEGER  :=  2; 

HEADERSTRING  :  ROW   STRING  TYPE; 

DONE  :  BOOLEAN  :=  FALSE; 
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HEADER  SIZE  :  INTEGER  :=  21; 

begin 
HEADER  STRING(1.. HEADER  SIZE)  ;=  "LIST  OF  HENRY  RECORDS"; 
PUT(HENRY   FILE,  "IN  LIST  HENRY  DATA");  NEW   LINE(HENRY  FILE); 
LOOP  EXIT  WHEN  DONE; 

SET  UP  SCREEN(HEADER  STRING,  HEADER  SIZE); 
LOOP 
put("DECLARATION      :  "); 
case  TEMP  POINTER. IDENTITY  is 

when  LOCAL   DECLARE    =>  put("Local  declare"); 

when  GLOBALDECLARE  =>  put("Global  declare"); 

when  others  =>  put("Undeclared"); 

end  case; 
new   line; 

put  ("NAME  :  "); 

if  TEMP  POINTER. NOMEN(l)  =  NULLCHAR  then 

put("None"); 
else 

TEMP_NAME(1..MAX  LINE  SIZE)    - 

TEMP_POINTER.NOMEN(I..MAX  LINE  SIZE); 

SHORT_NAME(l..SHORT_NAME  SIZE)  :=  TEMP_NAME(1..SH0RT_NAME_SIZE); 

put(SHORT_NAME); 

FOR  I  IN  l.SHORTNAME  SIZE  LOOP 
SHORT  NAME(I)  :=  NULLCHAR; 

END  LOOP; 
end  if; 
new    line; 

put(""ACTION  TYPE      :  "); 
case  TEMP  POINTER. TYPE  DEFINE  is 
when    UNDEFINED  =>  put("Undefined"); 

when    HENRY  HEAD   NODE     =>  put("Henry  Head  Node"); 
when    PACKAGETYPE         =>  put("Package  declaration"); 
when    PROCEDURETYPE      =>  put("Procedure  declaration"); 
when    FUNCTIONTYPE        =>  put("Function  declaration"); 
when    PARAMTYPE  =>  put("Parameter  declaration"); 

when    ASSIGNTYPE  =>  put("Assignment  delimiter"); 

when    IDENTTYPE  =>  put("Identifier"); 

when    DATASTRUCTURE      =>  put("Data  structure  descriptor"); 
when    FUNCALLORDS        =>  put("Function  or  data  descriptor"); 
when    PROCALL   OR   DS        =>  put("Procedure  or  data  descriptor"); 
when    ENDPARAM   DECLARE  =>  put("End  parameter  delimiter"); 
when    ENDACTUALPARAM    =>  put("End  actual  parameter  delimiter"); 
when    ENDDECLARATIONS    =>  put("End  declaration  delimiter"); 
when    ENDASSIGNTYPE     =>  put("End  assignment  statement  delimiter"); 
when    ENDPACKAGEDECLARE  =>  put("End  package  declaration  delimiter"); 
when    ENDPACKAGE  TYPE    =>  put("End  package  delimiter"); 
when    END_FUNCTION_TYPE  =>  put("End  function  delimiter"); 
when    ENDPROCEDURECALL  =>  put("End  procedure  delimiter"); 
when  others  =>  put("Unknown"); 

end  case; 
new    line; 
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putC'PARAMETER  TYPE  :  "); 

case  TEMP  POINTER.PARAM  TYPE  is 

when  IN   TYPE         =>  put("Input"); 

when  OUTTYPE       =>  put("Output"); 

when  INOUTTYPE    =>  put("Input/output"); 

when  others  =>  put("None"); 

end  case; 
new    line(2); 

putr ---"); 

new   line(2); 

PAUSE  PRINT(STOP,  RUNNING   COUNT,  DONE); 

if  (RUNNINGCOUNT  =  0)  AND  (NOT  DONE)  THEN 

RUNNING   COUNT  :=  1; 

SET  UP_SCREEN(HEADER   STRING,  HEADER  SIZE); 

end  if; 

Tl  :=  TEMP  POINTER. NEXTl; 

TEMPPOINTER  :=  Tl; 

EXIT  WHEN  (TEMPPOINTER  =  NULL)  OR  DONE; 

end  loop; 

if  NOT  DONE  THEN 

STOP  :=  1; 

RUNNING   COUNT  :=  1; 

put("*******************  End  data  collection  records"); 
p^^j,,  **,***************„j.  ne^   line- 

PAUSE  PRINT(STOP,  RUNNING   COUNT,  DONE); 
end  if; 
end  loop;  —done  loop 
end  LIST   HENRY   DATA; 


—lists  the  metric  calcualtion  data  for  each  procedure  or  function 
—of  the  particular  package  analyzed.  The  data  is  held  in  a  file 
-called  "Metric. data" 


procedure  LISTMETRICDATA  is 

IN   STRING    :  STRING(1..49); 
NUMBEROF    :  NATURAL; 
TEMP  :  POINTER  :=  HEAD. NEXTl; 

STOP  :  INTEGER  :=  13; 

RUNNING   COUNT  :  INTEGER  :=  1; 
HEADER  STRING  :  ROW  STRING   TYPE; 
DONE  :  BOOLEAN  :=  FALSE; 

HEADER  SIZE     :  INTEGER  :=  24; 

begin 

PUT(HENRY_FILE,  "IN  LIST  METRIC  DATA");  NEW  LINE(HENRY  FILE); 

HEADER  STRING(1.. HEADER  SIZE)  :=  "LIST  HENRY  METRIC  VALUES"; 
if  IS_OPEN(HENRY  OUT)  then 
if  OUT  FILE  =  MODE(HENRY  OUT)  then 
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RESET(HENRY  OUT,  IN  FILE); 
end  if; 

else  OPEN(HENRY  OUT,  IN  FILE,  HENRY  OUT  NAME); 
end  if; 
SET_UPSCREEN(HEADER  STRING,  HEADER  SIZE); 
IN_STRING(1..8)  :=  "PACKAGE  "; 
IN  STRING(9..49)  :=  INPUTFILE  NAME(1..41); 
put(IN   STRING); 
NEW   LINE(2); 
LOOP 
EXIT  WHEN  (END  OF  FILE(HENRY  OUT)  OR  DONE); 
FOR  J  IN  1.49  LOOP 
IN  STRING(J)  :=  NULL  CHAR; 
END  LOOP; 

GET  LINE(HENRY  OUT,  IN  STRING,  NUMBER  OF); 
PUT  LINE(IN  STRING); 

PAUSE  PRINT(STOP,  RUNNING   COUNT,  DONE); 
IF  (RUNNING   COUNT  =  0)  AND  (NOT  DONE)  THEN 
RUNNING   COUNT  :=  1; 

SET_UPSCREEN(HEADER  STRING,  HEADER  SIZE); 
end  if; 
END  LOOP; 
IF  (NOT  DONE)  THEN 
STOP  :=  1;  RUNNINGCOUNT  :=  1; 
PAUSE  PRINT(STOP,  RUNNING   COUNT,  DONE); 
end  if; 
CLOSE(HENRY   OUT); 

end  LIST   METRIC   DATA; 


—Lists  the  relative  comparison  metric  data.    This  listing 
—compares  each  procedure/function  analyzed  with  for  example  the 
—fan  in  numbers.  It  also  gives  a  verbal  report  for  each  function/ 
—procedure. 


procedure  WRITE  RELATIVE  DATA  is 

INDICATORl, 

INDICAT0R2, 

INDICATORS      ;  FLOAT  :=  0.0; 

UPPER   LIMIT     :  constant  FLOAT  :=  4.0; 

LOWER   LIMIT     :  constant  FLOAT  :=  0.25; 

TEMP  HOLDER     :  STRING(1..10); 

STOP,  RUNNING  :  INTEGER  :=  1; 

HEADER  STRING  :  ROW   STRING   TYPE; 

ROW   STRING      :  ROW   STRING  TYPE; 

SIZE  ;  INTEGER; 

DONE  :  BOOLEAN  :-  FALSE; 

HEADER   SIZE     :  INTEGER  :=  29; 

begin 
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HEADER  STRING(1.. HEADER  SIZE)  :=  "THE  RELATIVE  PERFORMANCE  DATA"; 

SET  UP  SCREEN(HEADER  STRING.  HEADER  SIZE); 

if  PROC   FUNCCOUNT  <  16  THEN  STOP  :=  PROCFUNCCOUNT; 

else  STOP  :=  16; 

end  if; 

PUT(HENRY_FILE,  "IN  WRITE  RELATIVE  DATA");  NEW  LINE(HENRY_FILE); 

-name  the  outer  loop  so  that  can  exit  gracefully  when  the  user 
-wants  to  quit 


OUTER   LOOP; 
FOR  J  IN  1.7  LOOP 
CASE  J  is 
when  1  =>  ROW  STRING(1..6)  :=  "FAN  IN"; 

SIZE  :=  6; 
when  2  =>  ROW  STRING{1..7)  :=  "FAN  OUT"; 

SIZE  :-  7; 
when  3  =>  ROW  STRING(1..10)  :=  "COMPLEXITY"; 

SIZE  :=  10; 
when  4  =>  ROW   STRING(l..ll)  :=  "GLOBAL  READ"; 

SIZE  —  11; 
when  5  =>  ROW   STRING(1..12)  :=  "GLOBAL  WRITE"; 

SIZE:=  12; 
when  6  =>  ROW   STRING(1..17)  :=  "GLOBAL  READ  WRITE"; 

SIZE  :=  17; 
when  7  =>  ROW   STRING(l..ll)  :=  "GLOBAL  FLOW"; 

SIZE  :=  11; 
when  others  =>  null; 
end  case; 

CENTER  STRING(ROW  STRING,  4,  SIZE); 
FOR  1  IN  1..PR0CFUNC  COUNT  LOOP 
SET  CURS0R_P0S(1,  I  +  5); 

REL   ARRAY(I).NAME  OF  :=  OUT  PUT  DATA(I).NAME  OF; 
PUT(REL_ARRAY(I).NAME  OF);  SETCURSOR   POS(42,  I  -r  5);  PUT("  :  "); 

—set  up  the  names  before  write  the  data 

CASE  J  is 

when  1  =>  put(REL   ARRAY(I).TYPE  FAN  IN); 

when  2  ->  put(REL   ARRAY(I).TYPE_FAN_OUT); 

when  3  =>  put(RELARRAY(I). TYPE  COMPLEXITY); 

when  4  =>  put(REL_ARRAY(I).TYPE_READ); 

when  5  =>  put(RELARRAY(I). TYPE  WRITE); 

when  6  =>  put(RELARRAY(I).TYPE_READ   WRITE); 

when  7  =>  putJREL   ARRAY(I).TYPE  FLOW); 

when  others  =>  null; 
end  case; 
NEW   LINE; 
PAUSE  PRINT(STOP,  RUNNING,  DONE); 

—boolean  done  is  set  true  by  user  answering  the  querry  to  quit 
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EXIT  OUTER  LOOP  WHEN  DONE; 

if  (RUNNING  =  0)  AND  (STOP  =  16)  THEN 

STOP  :=  PROC   FUNG   COUNT  -  17; 
elsif  RUNNING  =  0  THEN 

SET   UP  SCREEN(HEADER  STRING,  HEADER  SIZE); 
RUNNING  :=  1; 
end  if; 
end  loop; 
end  loop  OUTERLOOP; 

—set  up  to  loop  again  once  have  cycled  through  to  first  stop 
—count.    This  means  have  filled  the  screen  once 

STOP  :=  1;  RUNNING  :=  1; 

PAUSE  PRINT(STOP,  RUNNING,  DONE); 

CLEARSCREEN; 

PUT("The  following  are  the  maximums  for  each  calculation:  "); 

new   line; 

put  (" " ) ; 

new    line; 

put{"Fan  In  :  ");  put(REL   ARRAY(MAX_FAN_IN).NAME  OF);  newline; 

put("Fan  Out  :  ");  put(REL_ARRAY(MAX_FAN_OUT).NAME  OF);  new   line; 

put("Complexity  :  ");  put(REL_ARRAY(MAX_COMPLEXITY).NAME_OF):  NEWLINE; 

put("Global  Read  :  ");  put(REL    ARRAY(MAX_READ).NAME  OF);  NEWLINE; 

PUT("Global  Write         :  ");  put(REL   ARRAY(MAX_WRITE).NAME  OF);  NEW   LINE; 

PUT("Global  Read  Write  :  ");  put(REL    ARRAY(MAX_READ_WRITE).NAME  OF);  NEWLINE; 

PUT("Global  Flow  :  ");  put(REL_ARRAY(MAX_FLOW).NAME_OF);  NEWLINE; 

new    line; 

put(" - -"); 

new   line; 

STOP  :=  1;  RUNNING  :=  1; 

PAUSE  PRINT(STOP,  RUNNING,  DONE); 

SET_UPSCREEN(HEADER  STRING,  HEADER  SIZE); 

—calculate  the  indicator  numbers  so  that  can  determine  the  relative 
—performance  of  each  procedure/function  within  each  category 

FOR  I  IN  1..PR0C  FUNCCOUNT  LOOP 
if  RELARRAY(I). TYPE  FLOW  /=  0.0  THEN 
INDICATORl  :=    RELARRAY(I). TYPE  COMPLEXITY  / 

RELARRAY(I). TYPE  FLOW; 
else  INDICATORl  :=  REL_ARRAY(I). TYPE  COMPLEXITY; 
end  if; 

if  REL_ARRAY(I).TYPE  FAN  OUT  /=  0.0  THEN 
INDICAT0R2  :=    REL   ARRAY(I).TYPE  FAN  IN  / 

RELARRAY(I). TYPE  FAN  OUT; 
else  INDICATOR2  :=  REL   ARRAY(I). TYPE  FANJN; 
end  if: 

if  REL_ARRAY(I). TYPE  WRITE  /  =  0.0  THEN 
INDICATORS  :=    REL   ARRAY(I). TYPE  READ  / 

REL   ARRAY(I). TYPE  VVRITE; 
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else  INDICATORS  :=  REL   ARRAY(I).TYPE  READ; 

end  if; 

PUT(REL_ARRAY(I).NAME_OF);    put("  :  "); 
new   line; 

—put  out  the  results  of  the  indicator  analysis 

IF  INDICATORI  >  UPPER  LIMIT  THEN 

PUT("  -  Has  significant  conriplexity  compared  to  global  data  flow."); 
new    line; 

if  IN"DICAT0R2  >  UPPER  LIMIT  THEN 
put("  -  This  implies  poor  internal  code  structure.  "); 
new   line; 

put("  -  Consider  remodularization."); 
new   line; 
elsif  INDICAT0R2  <  LOWER  LIMIT  THEN 
PUT("  -  This  implies  an  extremely  complex  interface."); 
new   line; 
end  if; 
ELSIF  INDICATORI  <  LOWERLIMIT  THEN 
PL'T("  -  Has  significant  global  data  flow  compared  to  complexity."); 
new    line; 

if  IN"DICAT0R3  >  UPPER   LIMIT  THEN 
put("  -  This  implies  an  overworked  data  structure    "); 
new   line; 

put("  -  or  a  considerable  number  of  function  calls  "); 
new    line; 

put("  -  Consider  redistributing  the  data  structure  into  this  module"); 
new   line; 
elsif  INDICATORS  <  LOWER   LIMIT  THEN 
PUT("  -  This  implies  a  program  stress  point"); 
new   line; 

put("  -  or  a  critical  data  flow  point"); 
new   line; 

put("  -  Consider  reorganizing  the  data  structure."); 
new   line; 
end  if; 
ELSE 

TEMP  HOLDER(1..10)  :=  REL_ARRAY(I).NAME  OF(1..10); 
put("  -  Is  a  fairly  well  balanced  ");  put(TEMP_HOLDER); 
new    line; 

put("  -  This  implies  good  modularization.  "); 
new   line; 
END  IF; 
STOP  ;=  1;  RUNNING  :=  1; 
PAUSE  PRINT(STOP,  RUNNING,  DONE); 
EXIT  WHEN  DONE; 
end  loop; 

if  NOT  DONE  THEN 
STOP  ;=  1;  RUNNING  :=  1; 
PAUSE_PRINT(STOP,  RUNNING,  DONE); 
end  if; 
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end  WRITE  RELATIVE  DATA; 


—produces  a  bar  chart  of  each  metric  calculation  for  visual  comparisons 

procedure  GRAPH  RELATIVEDATA  is 

LOOP   CNT         :  INTEGER; 

ROW   STRING      :  ROW   STRING   TYPE; 

HEADER  STRING  :  ROW  STRING   TYPE; 

SIZE  :  INTEGER; 

STOP,  RUNNING  ;  INTEGER  :=  1; 

DONE  :  BOOLEAN  :=  FALSE; 

SCALE  :  INTEGER  :-  5; 

NUM  LOOP  CNT, 

REM  CNT  :  INTEGER; 

HEADER   SIZE     :  INTEGER  :=  30; 

begin 
NUM   LOOPCNT  :=  PROC   FUNG   COUNT  /  5; 
REMCNT   :=  PROC  FUNCCOUNT  REM  5; 

—loop  count  is  the  number  of  screens  need  to  display 
—remainder  count  is  the  partial  screen  that  is  left  over 

HEADER  STRING(1.. 30)  :=  "THE  GRAPHICAL  PERFORMANCE  DATA"; 

if  NUM   LOOP  CNT  >=  1    THEN  STOP  :=  5; 

else  STOP  :=  REM   CNT; 

end  if; 

PUT(HENRY  FILE,  "IN  WRITE  RELATIVE  DATA");  NEW  LINE(HENRY_FILE); 

SET  UP  SCREEN(HEADER  STRING,  HEADER  SIZE); 

—set  up  to  exit  gracefully  when  the  user  wants  to  quit 


GRAPH   LOOP: 
FOR  J  IN  1.7  LOOP 
CASE  J  is 
when  1  ->  R0W_STRING(1..6)  :-  "FAN  IN"; 

SIZE  :=  6; 
when  2  =>  ROW   STRING(1..7)  :=  "FAN  OUT"; 

SIZE  —  7; 
when  3  =>  ROW   STRING(1..10)  :=  "COMPLEXITY"; 

SIZE  :=  10; 
when  4  =>  ROW_STRING(l..ll)  ~  "GLOBAL  READ"; 

SIZE:=  11; 
when  5  ->  R0W_STRING(1..12)  :=  "GLOBAL  WRITE"; 

SIZE  :=  12; 
when  6  =>  ROW   STRING(1..17)  :=  "GLOBAL  READ  WRITE"; 

SIZE  :=  17; 
when  7  =>  ROW   STRING(l..ll)  :=  "GLOBAL  FLOW"; 

SIZE  :=  11; 
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when  others  =>  null; 
end  case; 

-set  up  to  graph  each  of  the  Henry  metric  variables 

CENTER  STRING(ROW  STRING,  4,  SIZE); 
FOR  I  IN  1..PR0C  FUNCCOUNT  LOOP 
new    line; 

REL"  ARRAY(I).NAME  OF  :=  OUTPUT  DATA(I).NAME_OF; 
PUT(REL   ARRAY(I).NAME  OF);  new   line; 
CASE  J  is 

when  1  =>  LOOP  CNT 

when  2  =>  LOOPCNT 

when  3  =>  LOOP  CNT 

when  4  =>  LOOPCNT 

when  5  =>  LOOP  CNT 

when  6  =>  LOOPCNT 

when  7  =>  LOOP  CNT 

when  others  =>  null; 
end  case; 


=  SCALE  *  INTEGER(REL   ARRAY(I).TYPE  FAN  IN); 

=  SCALE  *  INTEGERJrEL  ARRAY(I).TYPE  FANOUT); 

=  SCALE  *  INTEGER(RELARRAY(I). TYPE  COMPLEXITY); 

=  SCALE  *  INTEGER(RELARRAY(I). TYPE  READ); 

=  SCALE  *  INTEGER(RELARRAY(I).TYPE  WRITE); 

=  SCALE  *  INTEGER(RELARRAY(I). TYPE  READ   WRITE); 

=  SCALE  *  INTEGER(REL   ARRAY(I).TYPE  FLOW); 


—set  up  scaling  so  that  most  of  screen  is  filled  when  the  relative 
—score  is  maxed  at  10 

FOR  L  IN  1. LOOP  CNT  LOOP 

PUT("*"); 
END  LOOP; 
NEW_LINE(1); 

PAUSE  PRINT(STOP,  RUNNING,  DONE); 
EXIT  GRAPH   LOOP  WHEN  DONE; 

—graph  loop  actually  prints  the  bar  chart 

if  (RUNNING  -  0)  AND  (STOP  <  5)  THEN 
if  PROCFUNC  COUNT  >  5  THEN 

STOP  :=  5; 
end  if; 

SET  UP  SCREEN(HEADER  STRING,  HEADER  SIZE); 
RUNNING  :=  1; 
elsif  (RUNNING  =  0)  AND  (STOP  =  5)  THEN 
if  PROCFUNC  COUNT  =  5  THEN 
SET_UP_SCREEN(HEADER  STRING,  HEADERSIZE); 
RUNNING  :=  1; 

elsif  PROCFUNC  COUNT  >  5  THEN 
NUM  LOOP  CNT  :=  NUM  LOOP  CNT  -  1; 
if  NUM  LOOP  CNT  >=  1  THEN  STOP  :=  5;  RUNNING  :=  1; 
elsif  REM  CNT  /=  0  THEN 

STOP  :=  REM  CNT;  RUNNING  :=  1; 
else  SET  UP  SCREEN(HEADER_STRING,  HEADER   SIZE); 

RUNNING  :=  1; 
end  if; 
end  if; 
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end  if;i 

—all  the  above  checks  are  for  end  of  screen  printing  conditions 
—they  ensure  that  once  a  full  screen  has  been  displayed  that  a 
—  partial  is  scrolled  but  another  full  is  reprinted 

end  loop: 
end  loop  GRAPHLOOP; 

end  GRAPH   RELATIVE  DATA; 


—this  is  the  driver  module  called  from  Menu  procedure  which 
—controls  which  display  feature  will  be  called  and  produces  all 
—  the  relative  data  numbers.  It  also  does  the  initial  calculations 
—plus  finds  the  normalized  number  presently  set  at  10  for 
—full  screen  graph  display 


procedure  VIEW   HENRY(SELECTOR  :  in  integer)  is 

NORMALIZER  :  constant  FLOAT  ;=  10.0; 

begin 

PUT(HENRY  FILE,  "IN  VIEW  HENRY  PROCEDURE");  NEW_LINE(HENRY_FILE); 
CALCULATE  METRIC(HEAD,  HEAD  LINE); 

—search  for  the  maximums  for  each  variable 

FOR  I  IN  1..PR0CFUNC  COUNT  LOOP 
IF  OUT_PUT_DATA(I).TYPE  FAN  IN  > 

OUT  PUT_DATA(MAX  FAN  IN).TYPE_FAN  IN  THEN 

MAX  FAN  IN  :=  I; 
END  IF; 
IF  OUT_PUTDATA(I). TYPE  FAN  OUT  > 

OUT  PUT  DATA(MAX  FAN  OUT). TYPE  FAN  OUT  THEN 

MAX  Jean  OUT  =  i; 

END  IF; 

IF  OUT  PUT  DATA(I). TYPE  COMPLEXITY  > 

OUT  PUT  DATA{MAXCOMPLEXITY).TYPE_COMPLEXITY  THEN 

MAX  COMPLEXITY   =  I; 
END  IF; 
IF  OUT_PUT_DATA(I). TYPE  READ  > 

OUT  PUT  DATA(MAX  READ). TYPEREAD  THEN 

MAX   READ  :=  I; 
END  IF; 
IF  OUT  PUT _DATA(I). TYPE  VVRITE  > 

OUT  PUT  DATA(MAX   WRITE). TYPE  WRITE  THEN 

MAX   WRITE  :=  I; 
END  IF; 
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IF  OUT  PUT  DATA(I). TYPE  READ   WRITE  > 

OUT  PUT  DATA(MAX  READ   WRITE). TYPE  READ   WRITE  THEN 

MAX  READ   WRITE  :=  I; 
END  IF; 
IF  OUT  PUT  DATA(I). TYPE  FLOW  > 

OUT  PUT  DATA(MAX  FLOW). TYPEFLOW  THEN 

MAXFLOW  :=  I; 
END  IF; 
END  LOOP; 

—calculate  the  normalized  output  number 

FOR  I  IN  l.PROCFUNC  COUNT  LOOP 

if  OUT  PUT  DATA(MAX_FAN_IN).TYPE_FANJN  /=  0.0  then 
REL   ARRAY(I).TYPE  FAN  IN   :=  NORMALIZER  * 
(OUT  PUT  DATA(I). TYPE  FANJN  / 

OUT_PUT_DATA(MAX_FAN_IN).TYPE_FAN_IN); 
else  REL   ARRAY(I).TYPE_FAN_IN  :=  0.0; 
end  if; 

* 

if  OUT  PUT  DATA(MAX  FAN  OUT).TYPE  FAN  OUT  /=  0.0  THEN 
REL   ARRAY(I).TYPE  FAN  OUT  :=  NORMALIZER  * 
(OUT  PUT  DATA  (I). TYPE  FAN  OUT  / 

OUT  PUT  DATA  (MAX  FANOUT). TYPE  FANOUT); 
else  REL    ARRAY(I). TYPE  FAN  OUT  :=  0.0; 
end  if; 

if  OUT  PUT  DATA(MAX  COMPLEXITY). TYPE  COMPLEXITY  /=  0.0  THEN 
REL   ARRAY(I).TYPE  COMPLEXITY  :=  NORMALIZER  * 
(OUT_PUTDATA(I).TYPE  COMPLEXITY  / 

OUT  PUT  DATA(MAX  COMPLEXITY). TYPE  COMPLEXITY); 
else  REL   ARRAY(I).TYPE_COMPLEXITY  :=  0.0; 
end  if; 

if  OUT  PUT  DATA(MAX  READ). TYPE  READ  /=  0.0  THEN 
REL   ARRAY(l). TYPE  READ  :=  NORMALIZER  * 
(OUT  PUT  DATA(I).TYPE  READ  / 

OUT  PUT  DATA(MAX_READ).TYPE  READ); 
else  REL   ARRAY(I).TYPE  READ  :=  0.0; 
end  if; 

if  OUT_PUTDATA(MAX   WRITE)  TYPE  WRITE  /=  0.0  THEN 
REL   ARRAY(I). TYPE  WRITE  :-  NORMALIZER  * 
(OUT  PUT  DATA(I).TYPE  WRITE  / 

OUT  PUT  DAT  A  (MAX  WRITE). TYPE  WRITE); 
else  REL   ARRAY(I).TYPE  WRITE  :=  0.0; 
end  if; 

if  OUT  PUT  DATA(MAX  READ   WRITE). TYPE  READ   WRITE  /=  0.0  THEN 
REL   ARRAY(I). TYPE  READ  WRITE  :=  NORMALIZER  * 
(OUT  PUT  DATA(I).TYPE  READ   WRITE/ 
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OUT  PUT  DATA(MAX  READ   WRITE). TYPE  READ   WRITE); 
else  RELARRAY(I). TYPE  READ   WRITE  :=  0.0; 
end  if; 

if  OUT   PUT   DATA(MAX_FLOW). TYPE  FLOW  /=  0.0  THEN 
REL_ARRAY(I). TYPE  FLOW  —  NORMALIZER  * 
(OUT  PUT  DATA(I). TYPE  FLOW  / 

OUT_PUTDATA(MAX  FLOW). TYPE  FLOW); 
else  REL_ARRAY(I).TYPE_FLOW  :=  0.0; 
end  if; 


END  LOOP; 


case    SELECTOR    is 

when  1  =>  LIST   HENRY   DATA; 

when  2  =>  LIST  METRIC   DATA; 

when  3  =>  WRITE  RELATIVE  DATA; 

when  4  =>  GRAPH   RELATIVE  DATA; 

when  others  =>  null; 
end  case; 
FIRST   HENRY   CALL  :=  FALSE; 
END  VIEW   HENRY; 
END  HENRY   DISPLAY; 
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APPENDIX  C:  MODIFIED  PARSERS 


-  TITLE:  AN  ADA  SOFTWARE  METRIC 

--   MODULE  NAME:      PACKAGE  BYPASS  FUNCTION 

-  DATE  CREATED:     25  JUL  86 

-  LAST  MODIFIED:    16  APR  87 

-  AUTHORS:  LCDR  JEFFREY  L.  NIEDER 

LT  KARL  S.  FAIRBANKS,  JR. 
LCDR  PAUL  M.  HERZIG 

-  DESCRIPTION:    This  package  contains  the  workhorse  function 

required  to  identify  each  individual  token. 

with  HALSTEAD  METRIC,  BYPASS  SUPPORT  FUNCTIONS,  GLOBAL, 

GLOBAL  PARSER,  HENRY  GLOBAL,  HENRY,  TEXT  10; 
use  HALSTEAD  METRIC,  BYPASS  SUPPORT  FUNCTIONS,  GLOBAL, 
GLOBAL  PARSER.  HENRY  GLOBAL,  HENRY,  TEXT  10; 


package  BYPASS  FUNCTION  is 


function  BYPASS(TOKEN_ARRAY   ENTRYCODE  :  integer)  return  boolean; 
procedure  CONDUCT   RESERVE  WORDTESTfCONSUME  :  in  out  boolean) 
end  BYPASS  FUNCTION; 


package  body  BYPASSFUNCTION  is 

—  this  function  compares  the  lexeme  of  the  current  token  with  the 

—  token  currently  being  sought  by  the  parser.    If  the  current  token 

—  type  is  identifier,  then  a  test  is  conducted  to  ensure  it  is  not 
~    a  reserved  word. 

function  BYPASS(TOKEN   ARRAY   ENTRY  CODE  :  integer)  return  boolean  is 
CONSUME  :  boolean  :=  FALSE; 

LEXEME  :  string(l..LINESIZE); 

SIZE  :  natural; 

HENRY   LEXEME  :  string(l..MAX  LINE  SIZE); 

begin 
GET  CURRENT  TOKEN   RECORD(CURRENT  TOKEN  RECORD,  LEXEME  LENGTH); 
LEXEME  :=  CURRENT  TOKEN   RECORD. LEXEME; 
SIZE  :=  CURRENT  TOKEN  RECORD. LEXEME  SIZE-  1; 
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FOR  I  IN  1  ..MAX  LINE  SIZE  LOOP 

HENRY   LEXEME(I)  :=  NULL  CHAR; 
END  LOOP; 
HENRY   LEXEME  (1..SIZE)  :=  LEXEME(1..SIZE); 


case  TOKEN   ARRAY  ENTRYCODE  is 
when  TOKEN  IDENTIFIER  => 

if  (CURRENT  TOKEN  RECORD. TOKEN  TYPE  =  IDENTIFIER)  then 
CONSUME  :=  TRUE; 

CONDUCT  RESERVE  WORD  TEST(CONSUME); 
end  if; 

if  (CONSUME)  then 
CONVERT  UPPER  CASE(HENRY  LEXEME,  SIZE); 
CONVERT  UPPER  CASEJlEXEME,  SIZE); 
if  HENRY   WRITE  ENABLE  then 
put(RESULT_FILE,  "in  bypass  at  identifier    ");  new   line(RESULT_FILE); 

WRITE  HENRY  DATA(BLANK,  HENRY  LEXEME,  IDENTTYPE,  NONE,  NEXT  HEN); 
CREATE  NODE(NEXT  HEN,  LASTRECORD); 
HENRY   WRITE  ENABLE  :=  FALSE; 
end  if; 

OPERAND  METR1C(HEAD  NODE,  CURRENT  TOKEN  RECORD,  DECLARE  TYPE); 
DECLARE  TYPE   =  VARIABLE  DECLARE; 
end  if; 

when  TOKEN  NUMERIC   LITERAL  => 

if  (CURRENT  TOKEN  RECORD. TOKEN  TYPE  =  NUMERICLIT)  then 
CONSUME  :=  TRUE; 

DECLARE  TYPE   =  CONSTANT  DECLARE; 

OPERAND   METRIC(HEAD  NODE,  CURRENTTOKENRECORD,  DECLARETYPE); 
DECLARE  TYPE  :=  VARIABLE  DECLARE; 
if  HENRY   WRITE  ENABLE  then 

WRITE  HENRY   DATA  (LOCAL  DECLARE,  HENRY  LEXEME,  IDENTTYPE, 

NONE,  NEXT  HEN); 
CREATE  NODE(NEXT  HEN,  LAST  RECORD); 
HENRYWRITEENABLE   :=  FALSE; 
end  if; 
end  if; 

when  TOKEN  CHARACTER  LITERAL  => 

if  (CURRENT  TOKEN  RECORD. TOKEN  TYPE  -  CHARACTER  LIT)  then 
if  HENRY   WRITE  ENABLE  then 
WRITE  HENRY  DATA(LOCAL_DECLARE,  HENRY  LEXEME,  IDENT  TYPE, 

NONE,  NEXT  HEN); 
CREATE_NODE(NEXT  HEN,  LASTRECORD); 
HENRY   WRITE  ENABLE  :=  FALSE; 
end  if; 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN  STRING   LITERAL  => 

if  (CURRENTTOKEN  RECORD. TOKENTYPE  =  STRING   LIT)  then 
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CONSUME  :=  TRUE; 
if  HENRY   WRITE  ENABLE  then 
WRITE  HENRY  DATA(LOCAL   DECLARE,  HENRY  LEXEME,  IDENTTYPE, 

NONE,  NEXT  HEN); 
CREATE  NODE(NEXT  HEN,  LAST  RECORD); 
HENRYWRITE  ENABLE  :=  FALSE; 
end  if; 
end  if; 

when  TOKEN  END  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "end")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   BEGIN  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "begin")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   IF  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "if')  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN  THEN  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "then")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   ELSIF  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "elsif)  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   ELSE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "else")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   WHILE  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "while")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN   LOOP  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "loop")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   CASE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "case")  then 
CONSUME  :=  TRUE; 
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end  if; 

when  TOKEN   WHEN  => 

if  (ADJUST   LEXEME(LEXEME,  SIZE)  =  "when")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKENDECLARE  => 

if  (ADJUST   LEXEME(LEXEME,  SIZE)  =  "declare")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   FOR  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "for")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKENOTHERS  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  -  "others")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   RETURN  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "return")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   EXIT  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "exit")  then 
CONSUME  ;=  TRUE; 

end  if; 

when  TOKEN   PROCEDURE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "procedure")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   FUNCTION  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "function")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   WITH  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "with")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN  USE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "use")  then 

CONSUME  :=  TRUE; 
end  if; 
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when  TOKEN  PACKAGE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "package")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKENBODY  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  -  "body")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN  RANGE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "range")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKENJN  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "in")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKENOUT  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "out")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKENSUBTYPE  -> 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "subtype")  then 

CONSUME  ;=  TRUE; 
end  if; 

when  TOKEN   TYPE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "type")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKENIS  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "is")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN  NULL  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "null")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKENACCESS  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "access")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   ARRAY  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "array")  then 
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CONSUME  :=  TRUE; 

end  if; 

when  TOKEN   DIGITS  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "digits")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   DELTA  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "delta")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   RECORD   STRUCTURE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "record")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN  CONSTANT  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "constant")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKENNEW  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "new")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   EXCEPTION  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "exception")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKENRENAMES  => 

if  (ADJUST   LEXEME(LEXEME,  SIZE)  =  "renames")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   PRIVATE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "private")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   LIMITED  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "limited")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN  TASK  => 

if  (ADJUST   LEXEME(LEXEME,  SIZE)  =  "task")  then 

CONSUME  :=  TRUE; 
end  if; 
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when  TOKEN  ENTRY  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  -  "entry")  then 

CONSUME  :-  TRUE; 
end  if; 

when  TOKEN   ACCEPT  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "accept")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKENDELAY  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "delay")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKENSELECT  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "select")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   TERMINATE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "terminate")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN   ABORT  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "abort")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKENSEPARATE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "separate")  then 

CONSUME  ;=  TRUE; 
end  if; 

when  TOKEN   RAISE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "raise")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKENGENERIC  -> 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "generic")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN   AT  => 

if  (ADJUST   LEXEME(LEXEME,  SIZE)  =  "at")  then 

CONSUME  ;=  TRUE; 
end  if; 

when  TOKEN   REVERSE  => 
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if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "reverse")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN  DO  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  -  "do")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN  GOTO  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "goto")  then 
CONSUME  :-  TRUE; 

end  if; 

when  TOKENOF  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  -  "of)  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   ALL  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "all")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN  PRAGMA  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "pragma")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN  AND  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "and")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR  METRIC(TOKEN   AND,  CONSUME,  RESERVE  WORDTEST); 

when  TOKEN  OR  -> 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "or")  then 

CONSUME  :-  TRUE; 
end  if; 
OPERATOR  METRIC(TOKEN  OR,  CONSUME,  RESERVE  WORDTEST); 

when  TOKEN  NOT  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "not")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR  METRIC(TOKEN_NOT,  CONSUME,  RESERVEWORD  TEST); 

when  TOKENXOR  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "xor")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR_METRIC(TOKEN  XOR,  CONSUME,  RESERVEWORDTEST); 
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when  TOKEN   MOD  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "mod")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR   METRIC(TOKEN  MOD,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKENREM  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  -  "rem")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR  METRIC(TOKEN  REM,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKEN   ABSOLUTE  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "abs")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR  METRICfTOKEN   ABSOLUTE,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKENASTERISK  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "*")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR   METRIC(TOKEN   ASTERISK,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKEN   SLASH  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "/")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR   METRIC(TOKEN  SLASH,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKEN  EXPONENT  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  -  "**")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR_METRIC(TOKEN_EXPONENT,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKEN  PLUS  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "+")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR  METRIC(TOKEN_PLUS,  CONSUME,  RESERVEWORDTEST); 

when  TOKEN   MINUS  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "-")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR  METRIC(TOKEN  MINUS,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKEN   AMPERSAND  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "&")  then 
CONSUME  :=  TRUE; 
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end  if; 

OPERATOR  METR1C(T0KEN  AMPERSAND,  CONSUME,  RESERVE   WORD  TEST); 

when  TOKEN  EQUALS  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "  =  ")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR   METRIC(TOKEN  EQUALS,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKEN  NOTEQUALS  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "/  =  ")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR  METRIC(TOKEN  NOT  EQUALS,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKEN  LESS  THAN  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "<")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR   METRIC(TOKEN  LESS  THAN,  CONSUME,  RESERVE  WORD  TEST); 

when  TOKEN  LESS  THANEQUALS  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "<-")  then 

CONSUME  :=  TRUE; 
end  if; 
OPERATOR   METRIC(TOKEN  LESS  THAN  EQUALS,  CONSUME,  RESERVE   WORD  TEST); 

when  TOKEN  GREATER  THAN  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  ">")  then 

CONSUME   -  TRUE; 
end  if; 
OPERATOR   METRIC(TOKEN  GREATER  THAN,  CONSUME,  RESERVE  VVORD  TEST); 

when  TOKEN  GREATER  THAN  EQUALS  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  ">  =  ")  then 

CONSUME  :=  TRUE; 

end  if; 

OPERATOR   METRIC(TOKEN  GREATER  THAN  EQUALS,  CONSUME,  RESERVE  WORD  TES 

when  TOKEN   ASSIGNMENT  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  ":  =  ")  then 

CONSUME  :=  TRUE; 

OPERATOR  METRIC(TOKEN_ASSIGNMENT,  CONSUME,  RESERVEWORDTEST); 
end  if; 

when  TOKEN  COMMA  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  ",")  then 

CONSUME  :-  TRUE; 
end  if; 

when  TOKEN   SEMICOLON  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  ";")  then 
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UPDATE  LINE  COUNT; 
CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   PERIOD  => 

if  {ADJUST_LEXEME(LEXEME,  SIZE)  =  ".")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN  LEFTPAREN  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "(")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   RIGHT   PAREN  => 

if  (ADJUST   LEXEME(LEXEME,  SIZE)  =  ")")  then 
CONSUME  ;=  TRUE; 

end  if; 

when  TOKEN   COLON  => 

if  {ADJUST_LEXEME{LEXEME,  SIZE)  -  ":")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN  APOSTROPHE  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "'")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   RANGE  DOTS  => 

if  (ADJUST   LEXEME(LEXEME,  SIZE)  =  "..")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN   ARROW  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  "  =  >")  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN  BAR  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "|'')  then 
CONSUME  :=  TRUE; 

end  if; 

when  TOKEN  BRACKETS  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "<>")  then 

CONSUME  :=  TRUE; 
end  if; 

when  TOKEN  LEFT   BRACKET  => 

if  (ADJUST_LEXEME(LEXEME,  SIZE)  =  "<<")  then 
CONSUME  :=  TRUE; 
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end  if; 

when  TOKEN  RIGHT   BRACKET  => 

if  (ADJUST  LEXEME(LEXEME,  SIZE)  =  ">>")  then 

CONSUME  :=  TRUE; 
end  if; 

when  others  =>  null; 
end  case; 

ADJUST  TOKEN  BUFFER(CONSUME,  RESERVE  WORD  TEST); 

return  (CONSUME); 
end  BYPASS; 


—  this  procedure  tests  all  identifiers  to  verify  they  are  not  reserved 
~    words.    The  nnost  common  reserved  words  are  tested  first  and  the  process 
~    halts  when  a  match  is  made  or  the  test  fails, 
procedure  CONDUCT   RESERVEWORD_TEST(CONSUME  :  in  out  boolean)  is 
begin 
RESERVE   WORD  TEST  :=  TRUE; 

for  RESERVE  WORD   INDEX  in  TOKEN  END, TOKENABSOLUTE  loop 
if  (BYPASS(RESERVE_WORD_INDEX))  then 

CONSUME  :=  FALSE; 
end  if; 

exit  when  not  CONSUME; 
end  loop; 

RESERVE  WORD  TEST  :=  FALSE; 
end  CONDUCT   RESERVE   WORD   TEST; 

end  BYPASS   FUNCTION; 


--   TITLE:  AN  ADA  SOFTWARE  METRIC 

-   MODULE  NAME:      PACKAGE  PARSER  0 
--    DATE  CREATED:     09  OCT  86 
--    LAST  MODIFIED:    30  MAY  87 

--    AUTHORS:  LCDR  JEFFREY  L.  NIEDER 

LT  KARL  S.  FAIRBANKS,  JR. 
LCDR  PAUL  M.  HERZIG 
--    DESCRIPTION:    This  package  contains  eight  functions  that 
make  up  the  highest  level  productions  for  our  top-down, 
recursive  descent  parser. 
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with  PARSER  1,  PARSER  2,  PARSER  3,  HENRYGLOBAL,  HENRY,  BYPASS  FUNCTION, 

HALSTEAD  METRIC,  GLOBAL  PARSER,  GLOBAL,  TEXT  10; 
use  PARSER  1,  PARSER  2,  PARSER  3.  HENRY  GLOBAL,  HENRY,  BYPASSFUNCTION, 

HALSTEAD  METRIC,  GLOBAL  PARSER,  GLOBAL,  TEXT  10; 

package  PARSERO  is 

function  COMPILATION  return  boolean; 

function  COMPILATION   UNIT  return  boolean; 

function  CONTEXTCLAUSE  return  boolean; 

function  BASIC   UNIT  return  boolean; 

function  LIBRARY   UNIT  return  boolean; 

function  SECONDARYUNIT  return  boolean; 

function  LIBRARY  UNIT  BODY  return  boolean; 

function  SUBUNIT  return  boolean; 
end  PARSER   0; 


package  body  PARSER   0  is 

--  COMPILATION ->    [COMPILATION  UNIT1  + 
function  COMPILATION  return  boolean  is 
begin 

put("In  compilation  ");  new    line; 

put(RESULT   FILE.  "In  compilation  ");  new   line(RESULT_FILE); 
if  (COMPILATIONUNIT)  then 
while  (COMPILATIONUNIT)  loop 

null; 
end  loop: 
return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  COMPILATION; 


-- COMPILATION  UNIT-- >    CONTEXT  CLAUSE   BASIC  UNIT 
function  COMPILATION   UNIT  return  boolean  is 
begin 

put(RESULT_FILE,  "In  compilationunit  ");  new  Jine(RESULT_FILE); 
if  (CONTEXTCLAUSE)  then 
if  (BASIC   UNIT)  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  COMPILATIONUNIT; 
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-  CONTEXT  CLAUSE  -->    [with  WITH  OR  USE  CLAUSE  [use  WITH  ORUSE  CLAUSE]*  [* 
function  CONTEXTCLAUSE  return  boolean  is 
begin 

put(RESULT_FILE,  "In  context   clause  ");  new_line(RESULT_FILE); 
while  (BYPASS(TOKEN   WITH))  loop 
if  not  (WITHOR   USECLAUSE)  then 
SYNTAX_ERROR("Context  clause"); 
end  if; 

while  (BYPASS(TOKEN_USE))  loop 
if  not  (WITHORUSECLAUSE)  then 
SYNTAX_ERROR("Context  clause"); 
end  if; 
end  loop;  —  inner  while  loop 

end  loop;  —  outer  while  loop 

return  (TRUE); 
end  CONTEXT  CLAUSE; 


--  BASIC   UNIT  -->    LIBRARY  UNIT 
-->    SECONDARY  UNIT 
function  BASIC   UNIT  return  boolean  is 
begin 

put(RESULT   FILE,  "In  basic   unit  ");  new_line(RESULT_FILE); 
if  (LIBRARY  UNIT)  then 

return  (TRUE); 
elsif  (SECONDARY   UNIT)  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  BASIC   UNIT; 


-  LIBRARY   UNIT  -->    procedure  PROCEDURE   UNIT 
->    function  FUNCTION  UNIT 
->    package  PACKAGE  DECLARATION 
->    generic  GENERIC  DECLARATION 
function  LIBRARY   UNIT  return  boolean  is 
begin 

put(RESULT_FILE,  "In  library   unit  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN   PROCEDURE))  then 
DECLARE  TYPE :=  PROCEDURE  DECLARE; 
if  (PROCEDURE  UNIT)  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Library  unit"); 
end  if;  —  if  procedure   unit  statement 

elsif  (BYPASS(TOKEN_FUNCTION))  then 

103 


DECLARE  TYPE  :=  FUNCTION  DECLARE; 
if  (FUNCTIONUNIT)  then 

return  (TRUE); 
else 

SYNTAXERRORC'Library  unit"); 
end  if;  —  if  function   unit  statement 

elsif(BYPASS(TOKEN   PACKAGE))  then 
DECLARE  TYPE   =  PACKAGE  DECLARE; 
if  (PACKAGEDECLARATION)  then 

return  (TRUE); 
else 

SYNTAX   ERRORC'Library  unit"); 
end  if;  —  if  package   declaration 

elsif  (BYPASS(TOKEN_GENERIC))  then 
if  (GENERICDECLARATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Library  unit"); 
end  if;  —  if  generic   declaration 

else 

return  (FALSE); 
end  if; 
end  LIBRARY  UNIT; 


-  SECONDARY  UNIT  -->    LIBRARYUNITBODY 
-->    SUBUNIT 
function  SECONDARY   UNIT  return  boolean  is 
begin 

put(RESULT  FILE,  "In  secondary   unit  ");  newJine(RESULT_FILE); 
if  (LIBRARY  UNIT  BODY)  then 

return  (TRUE); 
elsif  (SUBUNIT)  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  SECONDARY  UNIT; 


-  LIBRARY   UNIT  BODY  ->    procedure  PROCEDURE  UNIT 
-->    function  FUNCTION   UNIT 
-->    package  PACKAGE  DECLARATION 
-->    generic  GENERIC   DECLARATION 
function  LIBRARY   UNIT  BODY  return  boolean  is 
begin 

put(RESULT_FILE,  "In  library   unit   body  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN  PROCEDURE))  then 
DECLARE  TYPE  :=  PROCEDUREDECLARE; 
if  (PROCEDURE  UNIT)  then 
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return  (TRUE); 
else 

SYNTAXERRORC'Library  unit  body"); 

end  if;  —  if  procedure   unit  statement 

elsif  (BYPASS(TOKEN_FUNCTION))  then 
DECLARE  TYPE  :=  FUNCTIONDECLARE; 
if  (FUNCTIONUNIT)  then 

return  (TRUE); 
else 

SYNTAXERRORC'Library  unit  body"); 
end  if;  —  if  function   unit  statement 

elsif  (BYPASS(TOKEN  PACKAGE))  then 
DECLARE  TYPE :=  PACKAGE  DECLARE; 
HENRY   WRITE  ENABLE  :=  TRUE; 
put(result    file,  "true");  new   line(result   file); 
if  (PACKAGE  DECLARATION)  then" 

return  (TRUE); 
else 

SYNTAX_ERROR("Library  unit  body"); 
end  if;  —  if  package   declaration 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   procedure) 

end  LIBRARY   UNIT  BODY; 


-  SUBUNIT  ->    separate  (NAME)  PROPERBODY 
function  SUBUNIT  return  boolean  is 
begin 

put(RESULT   FILE,  "In  subunit  ");  new   line(RESULT_FILE); 
if  (BYPASS(TOKEN  SEPARATE))  then 
if  (BYPASS(TOKEN  LEFTPAREN))  then 
if  (NAME)  then 
if  (BYPASS(TOKEN  RIGHT  PAREN))  then 
if  (PROPER   BODY)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Subunit"); 
end  if;  --  if  proper   body  statement 

else 

SYNTAX_ERROR("Subunit"); 
end  if;  —  if  bypass(token_right   paren) 

else 

SYNTAX_ERROR("Subunit"); 
end  if;  —  if  name  statement 

else 

SYNTAX_ERROR("Subunit"); 
end  if;  —  if  bypass(token_left_paren) 

else 

return  (FALSE); 
end  if;  -- if  bypass(token   separate) 
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end  SUBUNIT; 
end  PARSER   0; 


-  TITLE:  AN  ADA  SOFTWARE  METRIC 

--   MODULE  NAME:      PACKAGE  PARSER   1 
--   DATE  CREATED:     17  JUL  86 

-  LAST  MODIFIED:    30  MAY  87 

-  AUTHORS:  LCDR  JEFFREY  L.  NIEDER 

LT  KARL  S.  FAIRBANKS,  JR. 
LCDR  PAUL  M.  HERZIG 

-  DESCRIPTION:    This  package  contains  thirty-six  functions 

that  nnake  up  the  top  level  productions  for  our  top-down, 
recursive  descent  parser.  Each  function  is  preceded 
by  the  grammar  productions  they  are  implementing. 

with  PARSER   2,  PARSER   3,  HENRY  GLOBAL,  HENRY,  BYPASSFUNCTION, 

HALSTEAD   METRIC,  GLOBAL  PARSER,  GLOBAL,  TEXTIO; 
use  PARSER  2,  PARSER   3,  HENRY  GLOBAL,  HENRY,  BYPASSFUNCTION, 
HALSTEAD   METRIC,  GLOBAL  PARSER,  GLOBAL,  TEXT   10; 

package  PARSER    1  is 
function  GENERTC   DECLARATION  return  boolean; 
function  GENERICPARAMETERDECLARATION  return  boolean; 
function  GENERIC   FORMALPART  return  boolean; 
function  PROCEDURE  UNIT  return  boolean; 
function  SUBPROGRAM  BODY  return  boolean; 
function  FUNCTIONUNIT  return  boolean; 
function  FUNCTIONUNITTAIL  return  boolean; 
function  FUNCTIONBODY  return  boolean; 
function  FUNCTIONBODY   TAIL  return  boolean; 
function  TASKDECLARATION  return  boolean; 
function  TASK   BODY  return  boolean; 
function  TASK   BODYTAIL  return  boolean; 
function  PACKAGE  DECLARATION  return  boolean; 
function  PACKAGEUNIT  return  boolean; 
function  PACKAGEBODY  return  boolean; 
function  PACKAGE  BODY  TAIL  return  boolean; 
function  PACKAGE   TAIL   END  return  boolean; 
function  DECLARATIVE  PART  return  boolean; 
function  BASIC   DECLARATIVE  ITEM  return  boolean; 
function  BASICDECLARATION  return  boolean; 
function  LATERDECLARATIVE  ITEM  return  boolean; 
function  PROPERBODY  return  boolean; 
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function  SEQUENCE  OFSTATEMENTS  return  boolean; 
function  STATEMENT  return  boolean; 
function  COMPOUND   STATEMENT  return  boolean; 
function  BLOCKSTATEMENT  return  boolean; 
function  IF   STATEMENT  return  boolean; 
function  CASESTATEMENT  return  boolean; 
function  CASE  STATEMENTALTERNATIVE  return  boolean; 
function  LOOPSTATEMENT  return  boolean; 
function  EXCEPTIONHANDLER  return  boolean; 
function  ACCEPTSTATEMENT  return  boolean; 
function  SELECTSTATEMENT  return  boolean; 
function  SELECTSTATEMENTTAIL  return  boolean; 
function  SELECTALTERNATIVE  return  boolean; 
function  SELECTENTRYCALL  return  boolean; 
end  PARSER   1; 


package  body  PARSER    1  is 

-  GENERIC   DECLARATION  ->    [GENERIC  PARAMETER  DECLARATION  ?j 

GENERIC  FORMAL   PART 
function  GENERICDECLARATION  return  boolean  is 
begin 

put(RESULT   FILE,"In  generic  declaration  ");  new_line(RESULT_FILE); 
if  (GENERICPARAMETERDECLARATION)  then 

null; 
end  if; 
if  (GENERIC   FORMAL  PART)  then 

return(TRUE); 
else 

return  (FALSE); 
end  if; 
end  GENERIC  DECLARATION; 


-  GENERIC  PARAMETERDECLARATION  -->    IDENTIFIER   LIST  ;  [MODE  ?|  NAME 

[:-  EXPRESSION  ?]  ; 
->      type  private  [DISCRIMINANT  PART  ?] 
is  PRIVATE  TYPE  DECLARATION  ; 
->      type  private  [DISCRIMINANT  PART  ?) 

IS  GENERIC  TYPE  DEFINITION  ; 
->    with  procedure  PROCEDUREUNIT 
->    with  function  FUNCTION  UNIT 
function  GENERICPARAMETERDECLARATION  return  boolean  is 
begin 

put(RESULT   FILE,  "In  generic  parameter  declaration  ");  new_line(RESULT_FILE); 
if  (IDENTIFIER  LIST)  then 
if  (BYPASS(TOKEN_COLON))  then 
if  (MODE)  then 
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null; 
end  if;  —  if  mode  statement 

if  (NAME)  then  ~  check  for  typemark 

if  (BYPASS(TOKEN   ASSIGNMENT))  then 
if  (EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Generic  parameter  declaration"); 
end  if;  —  if  expression  statement 

end  if;  —  if  bypass(token   assignment) 

if  (BYPASS(TOKEN_SEMICOLON))  the'n 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  parameter  declaration"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Generic  parameter  declaration"); 
end  if;  —  if  type   mark  statement 

else 

SYNTAX_ERROR("Generic  parameter  declaration"); 
end  if;  —  if  bypass(token   colon) 

elsif  (BYPASS(TOKEN_TYPE))  then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
if  (DISCRIMINANT  PART)  then 

null; 
end  if;  -- if  discriminant   part 

if  (BYPASS(TOKEN_IS))  then 
if  (PRIVATE  TYPE  DECLARATION)  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Generic  parameter  declaration"); 
end  if;  —  if  bypass(token   semicolon) 

elsif  (GENERIC  TYPE  DEFINITION)  then" 
if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  parameter  declaration"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX   ERROR("Generic  parameter  declaration"); 
end  if;  —  if  private   type  declaration 

else 

SYNTAX   ERROR("Generic  parameter  declaration"); 
end  if;  —  if  bypass(token   is) 

else 

SYNTAX_ERROR("Generic  parameter  declaration"); 
end  if;  —  if  bypass(token   identifier) 

elsif  (BYPASS(TOKEN   WITH))  then 
if  (BYPASS(TOKEN  PROCEDURE))  then 
DECLARE  TYPE  :-  PROCEDURE  DECLARE; 
if  (PROCEDURE  UNIT)  then 
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return  (TRUE); 
else 

SYNTAX_ERROR("Generic  parameter  declaration"); 
end  if;  —  if  procedure   unit  statement 

elsif  (BYPASS(TOKEN_FUNCTION))  then 
DECLARE  TYPE  :-  FUNCTIONDECLARE; 
if  (FUNCTION   UNIT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  parameter  declaration"); 
end  if;  —  if  function   unit  statement 

else 

SYNTAX   ERROR("Generic  parameter  declaration"); 
end  if;  —  if  bypass(token   procedure) 

else 

return  (FALSE); 
end  if;  —  if  identifier   list 

end  GENERIC  PARAMETER  DECLARATION; 


--  GENERIC   FORMAL   PART  ->    procedure  PROCEDURE  UNIT 
-->    function  FUNCTION   UNIT 
-->    package  PACKAGE   DECLARATION 
function  GENERIC   FORMAL   PART  return  boolean  is 
begin 

put(RESULT   FILE,  "In  generic  formal  part  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN   PROCEDURE))  then 
DECLARE  TYPE :=  PROCEDURE  DECLARE; 
if  (PROCEDURE  UNIT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  formal  part"); 
end  if;  —  if  procedure   unit  statement 

elsif  (BYPASS(TOKEN   FUNCTION))  then 
DECLARE  TYPE  :=  FUNCTION  DECLARE; 
if  (FUNCTIONUNIT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  formal  part"); 
end  if;  —  if  function   unit  statement 

elsif  (BYPASS(TOKEN_PACKAGE))  then 
DECLARE  TYPE  :=  PACKAGE  DECLARE; 
if  (PACKAGE  DECLARATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  formal  part"); 
end  if;  —  if  package   declaration 

else 

return  (FALSE); 
end  if; 
end  GENERIC  FORMAL   PART; 
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-  PROCEDURE  UNIT  -->    identifier  [FORMAL   PART  ?]  is  SUBPROGRAM  BODY 
->    identifier  [FORMAL   PART  ?)  ; 
->    identifier  [FORMAL   PART  ?]  renames  NAME  ; 
function  PROCEDUREUNIT  return  boolean  is 
begin 

put(RESULT   FILE,  "In  procedure  unit  ");  new  Jine(RESULT_FILE); 
DECLARATION  :=  TRUE; 

HENRY   WRITE   ENABLE  :=  TRUE; 
if  (BYPASS(TOKEN_IDENTIFIER))  then 
if  PACKAGE  BODY  DECLARE  then 
WRITE  HENRY  DATA(LOCAL   DECLARE,  DUMMY  LEXEME, 
PROCEDURE  TYPE,  NONE,  LASTRECORD); 
end  if; 

SCOPE  LEVEL  :=  SCOPE  LEVEL  +  1; 
if  (FORMAL   PART)  then 

null; 
end  if;  —  if  formal  part  statement 

if  (BYPASS(T0KEN_1S))  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  END  PARAM  DECLARE, 

NONE,  NEXTHEN); 
CREATE  NODE(NEXT  HEN,  LASTRECORD); 
WRITE  LINE  COUNT(LAST  RECORD. NOMEN,  HENRYLINE  COUNT, 

DUMMY9S,  NEXT   LINE); 
if  (SUBPROGRAM  BODY)    then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  END  PROCEDURE  CALL, 

NONE,  NEXT   HEN); 
CREATE  NODE(NEXT  HEN,  LAST  RECORD); 
WRITE  LINE  COUNT(DUMMY  LEXEME,  DUMMY9s,  HENRY  LINE  COUNT, 

NEXT   LINE); 
CREATE  LINE_COUNT_NODE(NEXT_LINE,  LASTLINE); 
SCOPE  LEVEL  :=  SCOPE  LEVEL  -  1; 
return  (TRUE); 
else 

SYNTAX_ERROR("Procedure  unit"); 
end  if;  --  if  subprogram  body  statement 

elsif  (BYPASS(TOKEN_SEMICOLON))  then 
SCOPE  LEVEL  :=  SCOPE  LEVEL  -  1; 
return  (TRUE); 
elsif  (BYPASS(TOKEN_RENAMES))  then 
if  (NAME)  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 
SCOPE  LEVEL  ;=  SCOPELEVEL  -  1; 
return  (TRUE); 
else 

SYNTAX  ERROR("Procedure  unit"); 
end  if;  ~  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Procedure  unit"); 
end  if;  --  if  name  statement 
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end  if;  —  if  bypass(token    is) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   identifier) 

end  PROCEDURE   UNIT; 


-  SUBPROGRAM  BODY  -->    new  NAME  [GENERICACTUALPART  ?)  ; 

—  >    separate  ; 

—  >    <>  ; 

-->    [DECLARATIVEPART  ?]  begin  SEQUENCEOFSTATEMENTS 
[exception  [EXCEPTION_HANDLERl+  ?]  end  [DESIGNATOR  ?|  ; 
->    NAME : 
function  SUBPROGRAM   BODY  return  boolean  is 

NAME  POINTER  :  POINTER; 

begin 

put(RESULT_FILE,  "In  subprogrambody  ");  new  line(RESULT   FILE); 
NAME  POINTER  :=  NEXT  HEN; 
DECLARATION  :=  TRUE; 
if  (BYPASS(TOKEN   NEW))then 
HENRY   WRITE   ENABLE  :=  FALSE; 
if  (NAME)  then 
if  (GENERICACTUAL  PART)  then 

null; 
end  if;  —  if  generic  actual  part 

if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Subprogram  body"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX  ERROR("Subprogram  body"); 
end  if;  —  if  name  statement 

elsif  (BYPASS(TOKEN_SEPARATE))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Subprogram  body"); 
end  if;  —  if  bypass(token   semicolon) 

elsif  (BYPASS(TOKEN_BRACKETS))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Subprogram  body"); 
end  if;  —  if  bypass(token_semicolon) 

elsif  (DECLARATIVE  PART)  then 

WRITE  HENRY   DATA(BLANK,  DUMMY  LEXEME,  END  DECLARATIONS, 

NONE,  NEXT   HEN); 
CREATE_NODE(NEXT_HEN,  LAST  RECORD); 

111 


if  (BYPASS(TOKEN  BEGIN))  then 
DECLARATION  :=  FALSE; 
if  (SEQUENCEOFSTATEMENTS)  then 
if  (BYPASS(TOKEN  EXCEPTION))  then 
if  (EXCEPTION   HANDLER)  then 
while  (EXCEPTIONHANDLER)  loop 

null; 
end  loop; 
else 

SYNTAX_ERROR("Subprogram  body"); 
end  if;  —  if  exception   handler  statement 

end  if;  —  if  bypass(token   exception) 

if  (BYPASS(TOKEN_END))  then 

HENRY  WRITE  ENABLE  :=  FALSE; 
if  (DESIGNATOR)  then 

null; 
end  if;  —  if  designator  statement 

if  (BYPASS(TOKEN_SEMICOLON))  then 
DECLARATION  :=  TRUE; 
return  (TRUE); 
else 

SYNTAX   ERRORC'Subprogram  body"); 
end  if;  ~  if  bypass(token   semicolon) 

else 

SYNTAX  ERROR("Subprogram  body"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("Subprogram  body"); 
end  if;  —  if  sequence  of  statements 

else 

SYNTAX   ERROR("Subprogram  body"); 
end  if;  —  if  bypass(token   begin) 

elsif(BYPASS(TOKEN   BEGIN))  then 
DECLARATION  :=  FALSE; 
WRITE  HENRY  DATA(BLANK,  DUMMY   LEXEME.  END  DECLARATIONS, 

NONE,  NEXT  HEN); 
CREATE  NODE(NEXT  HEN,  LAST  RECORD); 
if  (SEQUENCEOF  STATEMENTS)  then 
if  (BYPASS(TOKEN_EXCEPTION))  then 
if  (EXCEPTIONHANDLER)  then 
while  (EXCEPTION  HANDLER)  loop 

null; 
end  loop; 
else 

SYNTAX_ERROR("Subprogram  body"); 
end  if;  ~  if  exception   handler  statement 

end  if;  —  if  bypass(token   exception) 

if  (BYPASS(TOKEN_END))  then 
HENRY  WRITE  ENABLE  :=  FALSE; 
if  (DESIGNATOR)  then 

null; 
end  if;  —  if  designator  statement 
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if  (BYPASS(TOKEN  SEMICOLON))  then 
DECLARATION  :=  TRUE; 
return  (TRUE); 
else 

SYNTAX_ERROR("Subprogram  body"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX   ERRORC'Subprogram  body"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("Subprogram  body"); 
end  if;  —  if  sequence  of  statements 

elsif  (NAME)  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Subprogram  body"); 
end  if;  —  if  bypass(token   semicolon) 

else 

return  (FALSE); 
end  if;  --  if  bypass(token   new) 

end  SUBPROGRAM   BODY: 


--  FUNCTION   UNIT  -->    DESIGNATOR   FUNCTION  UNIT  TAIL 
function  FUNCTION   UNIT  return  boolean  is 
begin 

put(RESULT_FILE,  "In  function  unit  ");  new   line(RESULT_FILE); 
DECLARATION  :=  TRUE; 
HENRY   WRITE  ENABLE  :=  TRUE; 
if  (DESIGNATOR)  then 
if  PACKAGE  BODY  DECLARE  then 

WRITE  HENRY  DATA(LOCAL  DECLARE,  DUMMY   LEXEME,  FUNCTION  TYPE, 

NONE,  LAST  RECORD); 
WRITE_LINECOUNT(LAST  RECORD. NOMEN,  HENRYLINECOUNT, 
DUMMY9S,  NEXT  LINE); 
end  if; 

SCOPELEVEL  :=  SCOPE  LEVEL  +  1; 
if  (FUNCTION  UNIT  TAIL)  then 

SCOPELEVEL  :=  SCOPELEVEL  -  1; 
return  (TRUE); 
else 

SYNTAX_ERROR("Function  unit"); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  FUNCTION   UNIT; 
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-  FUNCTIONUNITTAIL  -->    is  new  NAME  [GENERIC   ACTUAL  PART  "!]  ; 

->    [FORMAL   PART  ''I  return  NAME   FUNCTION  BODY 
function  FUNCTIONUNITTAIL  return  boolean  is 
begin 

put(RESULT_FILE,  "In  function  unit  tail  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN_IS))  then 

FUNCTION   PARAM   DECLARE  :=  TRUE; 
if  (BYPASS(TOKEN_NEW))  then 
if  (NAME)  then 
if  (GENERIC   ACTUAL   PART)  then 

null; 
end  if;  —  if  generic  actual  part 

if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Function  unit  tail"); 
end  if;  ~  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Function  unit  tail"); 
end  if;  —  if  name  statement 

else 

SYNTAX_ERROR("Function  unit  tail"); 
end  if;  —  if  bypass(token   new) 

elsif  (FORMALPART)  then 

FUNCTION  PARAM   DECLARE  :-  FALSE; 
if  (BYPASS(TOKEN  RETURN))  then 
if  (NAME)  then  —  check  for  type   mark 

if  (FUNCTION  BODY)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Function  unit  tail"); 
end  if;  —  if  function  body  statement 

else 

SYNTAX_ERROR("Function  unit  tail"); 
end  if;  —  if  type  mark  statement 

else 

SYNTAX_ERROR("Function  unit  tail"); 
end  if;  —  if  bypass(token   return) 

elsif  (BYPASS(TOKEN_RETURN))  then 
if  (NAME)  then  —  check  for  type   mark 

if  (FUNCTION   BODY)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Function  unit  tail"); 
end  if;  —  if  function  body  statement 

else 

SYNTAX_ERROR("Function  unit  tail"); 
end  if;  —  if  type  mark  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   is) 

end  FUNCTIONUNIT  TAIL; 
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-  FUNCTION  BODY  -->    is  [FUNCTION  BODYTAIL  ?j 
->    ; 
function  FUNCTION   BODY  return  boolean  is 
begin 

put(RESULT   FILE,  "In  function  body  ");  new  Jine(RESULT_FILE); 
if  (BYPASS(TOKEN  IS))  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  ENDPARAMDECLARE,  NONE,  NEXT  HEi^ 
CREATE  NODE(NEXT_HEN,  LAST  RECORD); 
if  (FUNCTION  BODYTAIL)  then 
WRITE  LINE  COUNT(DUMMY  LEXEME,  DUMMYQs,  HENRY  LINE  COUNT, 

NEXT  LINE); 
CREATE  LINE  COUNT  NODE(NEXT  LINE,  LAST  LINE); 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  ENDFUNCTION  TYPE, 

NONE,  NEXT   HEN); 
CREATE  NODE(NEXT  HEN,  LAST  RECORD); 
end  if; 

return  (TRUE); 
elsif  (BYPASS(TOKEN   SEMICOLON))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  FUNCTION  BODY; 


--  FUNCTION   BODY   TAIL  -->    separate  ; 
--><>; 

->    SUBPROGRAM  BODY 
->    NAME ; 
function  FUNCTION   BODYTAIL  return  boolean  is 
begin 

put(RESULT   FILE,  "In  function  body  tail  ");  newJine(RESULT_FILE); 
if  (BYPASS(TOKEN  SEPARATE))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Function  body  tail"); 
end  if;  —  if  bypass(token   semicolon) 

elsif  (BYPASS(TOKEN   BRACKETS))  then" 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Function  body  tail"); 
end  if;  —  if  bypass(token_sennicolon) 

elsif  (SUBPROGRAMBODY)  then 

return  (TRUE); 
elsif  (NAME)  then 
if  (BYPASS(TOKEN  SEMICOLON))  then 
return  (TRUE); 
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else 

SYNTAX_ERROR("Function  body  tail"); 
end  if;  —  if  bypass(token   semicolon) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   separate) 

end  FUNCTION   BODY  TAIL; 


-  TASK  DECLARATION  -->    body  TASK  BODY  ; 

->    [type  ?|  identifier  [is  [ENTRY_DECLARATION|* 

[REPRESENTATIONCLAUSEj*  end  [identifier  ?|  ?| 
function  TASKDECLARATION  return  boolean  is 
begin 

put(RESULT_FILE,  "In  taskdeclaration  ");  new_line(RESULT_FILE); 
DECLARATION  :=  TRUE; 
if  (BYPASS(TOKEN_TYPE))  then 

null; 
end  if;  ~  if  bypass(token   type) 

if  (BYPASS(TOKEN_BODY))  then 
if  (TASK   BODY)  then 
if  (BYPASS(TOKEN   SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Task  declaration"); 
end  if; 
else 

SYNTAX_ERROR("Task  declaration"); 
end  if;  —  if  task   body  statement 

elsif  (BYPASS(TOKEN_IDENTIFIER))  then 
SCOPE  LEVEL  :=  SCOPE  LEVEL  ^  I; 
if  (BYPASS(TOKEN_IS))  then 
while  (ENTRY  DECLARATION)  loop 

null; 
end  loop; 
while  (REPRESENT  ATIONCLAUSE)  loop 

null; 
end  loop; 

if  (BYPASS(TOKEN  END))  then 
if  (BYPASS(TOKEN   IDENTIFIER))  then 

null; 
end  if;  —  if  bypass(token   identifier) 

if  (BYPASS(TOKEN   SEMICOLON))  then 
SCOPELEVEL  :=  SCOPELEVEL  -  1; 
return  (TRUE); 
else 

SYNTAX_ERROR("Task  declaration"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Task  declaration"); 
end  if;  —  if  bypass(token   end) 
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elsif  (BYPASS(TOKEN_SEMICOLON))  then 
SCOPE   LEVEL  :=  SCOPE  LEVEL  -  1; 
return  (TRUE); 
else 

SYNTAXERRORC'Task  declaration"); 
^nd  if;  ..  if  bypass(token_is) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   body) 

end  TASK  DECLARATION; 


--  TASK   BODY  ->    identifier  is  TASK   BODY  TAIL 
function  TASKBODY  return  boolean  is 
begin 

put(RESULT   FILE,  "In  task   body  ");  new   line(RESULT_FILE); 
if  (BYPASS(TOKEN   IDENTIFIER))  then 
SCOPE  LEVEL  :=  SCOPE  LEVEL  +  1; 
if  (BYPASS(TOKEN   IS))  then 
if  (TASK   BODY  TAIL)  then 
SCOPE  LEVEL  :=  SCOPE  LEVEL  -  1; 
return  (TRUE); 
else 

SYNTAXERRORC'Task  body"); 
end  if;  —  if  task   body   tail  statement 

else 

SYNTAXERRORC'Task  body"); 
end  if;  —  if  bypass(token   is) 

else 

return  (FALSE); 
end  if;  ~  if  bypass(token   identifier) 

end  TASK   BODY; 


--  TASK   BODY  TAIL  -->    separate 

-->    [DECLARATIVE  PART  ?]  begin  SEQUENCE  OF  STATEMENTS 
[exception  iEXCEPTION_HANDLER]+  ?]  end  [identifier  ?[ 
function  TASK  BODY  TAIL  return  boolean  is 
begin 

put(RESULT_FILE,  "In  taskbodytail  ");  new_line(RESULT_FILE); 
DECLARATION   =  TRUE; 
if  (BYPASS(TOKEN_SEPARATE))  then 

return  (TRUE); 
elsif  (DECLARATIVE  PART)  then 
if  (BYPASS(TOKEN  BEGIN))  then 
DECLARATION  :=  FALSE; 
if  (SEQUENCEOFSTATEMENTS)  then 
if  (BYPASS(TOKEN_EXCEPTION))  then 
if  (EXCEPTIONHANDLER)  then 
while  (EXCEPTIONHANDLER)  loop 
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null; 
end  loop; 
else 

SYNTAX   ERRORC'Task  body  tail"); 
end  if;  —  if  exception   handler  statement 

end  if;  —  if  bypass(token    exception) 

if(BYPASS(TOKEN  END))then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 

null; 
end  if;  —  if  bypass(token_identifier) 

DECLARATION  :=  TRUE; 
return  (TRUE); 
else 

SYNTAX_ERROR("Task  body  tail"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("Task  body  tail"); 
end  if;  —  if  sequence   of  statements 

else 

SYNTAXERRORC'Task  body  tail"); 
end  if;  —  if  bypass(token   begin) 

elsif  (BYPASS(TOKEN_BEGIN))  then 
DECLARATION  :=  FALSE; 
if  (SEQUENCE  OF  STATEMENTS)  then 
if  (BYPASS(TOKEN   EXCEPTION))  then 
if  (EXCEPTION   HANDLER)  then 
while  (EXCEPTIONHANDLER)  loop 

null; 
end  loop; 
else 

SYNTAXERRORC'Task  body  tail"); 
end  if;  ~  if  exception   handler  statement 

end  if;  —  if  bypass(token   exception) 

if  (BYPASS(TOKEN_END))  then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 

null; 
end  if;  —  if  bypass(token   identifier) 

DECLARATION  :=  TRUE; 
return  (TRUE); 
else 

SYNTAX   ERROR("Task  body  tail"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("Task  body  tail"); 
end  if;  —  if  sequence   of  statements 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   separate) 

end  TASK   BODY  TAIL; 
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-  PACKAGE  DECLARATION  -->    body  PACKAGE  BODY 
-->    identifier  PACKAGE  UNIT 
function  PACKAGEDECLARATION  return  boolean  is 
begin 

put(RESULT_FILE,  "In  packagedeclaration  ");  new_line(RESULT_FILE); 
DECLARATION  :=  TRUE; 
HENRY   WRITE  ENABLE  ;=  TRUE; 
if  (BYPASS(TOKEN_BODY))  then 
PACKAGE  BODY   DECLARE  :=  TRUE; 
HENRY   WRITE  ENABLE     —  FALSE; 
if  (PACKAGEBODY)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Package  declaration"); 
end  if;  —  if  package  unit  statement 

elsif  (BYPASS(TOKEN_IDENTIFIER))  then 
WRITE  HENRY  DATA(LOCAL   DECLARE,  DUMMY  LEXEME,  PACKAGE  TYPE, 

NONE,  LASTRECORD); 
SCOPE  LEVEL  :=  SCOPE  LEVEL  +  1; 
if  (PACKAGEUNIT)  then 
SCOPE  LEVEL  :=  SCOPELEVEL  -  1; 
return  (TRUE); 
else 

SYNTAX_ERROR("Package  declaration"); 
end  if;  --  if  package   unit   tail  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   package) 

end  PACKAGE  DECLARATION; 


-  PACKAGE  BODY  -->    identifier  is  PACKAGEBODY  TAIL 
function  PACKAGEBODY  return  boolean  is 
begin 
put(RESULT_FILE,  "In  packagebody  ");  new_line(RESULT_FILE); 

if  (BYPASS(TOKEN  IDENTIFIER))  then 
SCOPE  LEVEL  :-  SCOPE  LEVEL  +  1; 
if  (BYPASS(TOKEN_IS))  then 
if  (PACKAGE  BODY  TAIL)  then 
WRITE  HENRY  DATA(BLANK,  DUMMYLEXEME,  ENDPACKAGETYPE, 

NONE,  NEXT  HEN); 
SCOPE  LEVEL  :-  SCOPE  LEVEL  -  1; 
return  (TRUE); 
else 

SYNTAX_ERROR("Package  body"); 
end  if;  —  if  package   body   tail  statement 

else 

SYNTAX   ERROR("Package  body"); 
end  if;  ~  if  bypass(token_is) 

else 
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return  (FALSE); 
end  if;  —  if  bypass(token    identifier) 

end  PACKAGE  BODY; 


--  PACKAGE   BODYTAIL  -->    separate  ; 

->    IDECLARATIVE  PART  V  [begin  SEQUENCE  OF  STATEMENTS 
[exception  [EXCEPTION_HANDLERi+  ?]  ?] 
end    identifier  ?|  ; 
function  PACKAGE  BODYTAIL  return  boolean  is 
begin 

put(RESULT_FILE,  "In  packagebody  Jail  ");  new   line(RESULT_FILE); 
DECLARATION  :=  TRUE; 
if  (BYPASS(TOKEN_SEPARATE))  then 
if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Package  body  tail"); 
end  if;  —  if  bypass(token   semicolon) 

elsif  (DECLARATIVEPART)  then 
DECLARATION  :=  FALSE; 
if  (BYPASS(TOKEN_BEGIN))  then 
if  (SEQUENCE  OFSTATEMENTS)  then 
if  (BYPASS(TOKEN  EXCEPTION))  then 
if  (EXCEPTION  HANDLER)  then 
while  (EXCEPTIONHANDLER)  loop 

null; 
end  loop; 
else 

SYNTAX   ERROR("Package  body  tail"); 
end  if;  —  if  exception   handler  statement 

end  if;  —  if  bypass(token   exception) 

if  (BYPASS(TOKEN  END))  then 

HENRY   WRITE  ENABLE   -  FALSE; 
if  (BYPASS(TOKEN_IDENTIFIER))  then 
null; 
end  if;  —  if  bypass(token   identifier) 

if  (BYPASS(TOKEN_SEMICOLON))  then" 
DECLARATION  :=  TRUE; 
return  (TRUE); 
else 

SYNTAX   ERROR("Package  body  tail"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Package  body  tail"); 
end  if;  ~  if  bypass(token   end) 

else 

SYNTAX_ERROR("Package  body  tail"); 
end  if;  —  if  sequence   of  statements 

elsif  (BYPASS(TOKEN  END))  then 

HENRYWRITEENABLE  :=  FALSE; 
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if  (BYPASS(TOKEN_IDENTIFIER))  then 

null; 
end  if;  ~  if  bypass(token   identifier) 

if  (BYPASS(TOKEN  SEMICOLON))  then 
DECLARATION  :=  TRUE; 
return  (TRUE); 
else 

SYNTAX_ERROR("Package  body  tail"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Package  body  tail"); 
end  if;  —  if  bypass(token   begin) 

elsif(BYPASS(TOKEN  BEGIN))  then 
DECLARATION  :=  FALSE; 
if  (SEQUENCEOFSTATEMENTS)  then 
if  (BYPASS(TOKEN  EXCEPTION))  then 
if  (EXCEPTION   HANDLER)  then 
while  (EXCEPTIONHANDLER)  loop 

null; 
end  loop; 
else 

SYNTAX   ERROR("Package  body  tail"); 
end  if;  —  if  exception   handler  statement 

end  if;  —  if  bypass(token   exception) 

if(BYPASS(TOKEN  END))then 
HENRY   WRITE  ENABLE  :=  FALSE; 
if  (BYPASS(TOKEN_IDENTIFlER))  then 

null; 
end  if;  —  if  bypass(token   identifier) 

if  (BYPASS(TOKEN_SEMICOLON))  then 
DECLARATION  :-  TRUE; 
return  (TRUE); 
else 

SYNTAX_ERROR("Package  body  tail"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Package  body  tail"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("Package  body  tail"); 
end  if;  —  if  sequence   of  statements 

elsif  (BYPASS(TOKEN_END))  then 

HENRY   WRITE  ENABLE  :=  FALSE; 
if  (BYPASS(TOKEN  IDENTIFIER))  then 

null; 
end  if;  —  if  bypass(token_identifier) 

if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Package  body  tail"); 
end  if;  —  if  bypass(token   semicolon) 

else 
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return  (FALSE); 
end  if;  —  if  bypass(token   separate) 

end  PACKAGE  BODY  TAIL; 


-  PACKAGE  UNIT  -->    is  PACKAGETAIL  END 

—  >    renames  NAME  ; 
function  PACKAGE  UNIT  return  boolean  is 
begin 

put(RESULT_FILE,  "In  packageunit  ");  new_line(RESULT_FILE); 
if  (BYPASS(T0KEN_1S))  then 
if  (PACKAGETAILEND)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Package  unit"); 
end  if; 
elsif  (BYPASS(TOKEN_RENAMES))  then 
if  (NAME)  then 
if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Package  unit"); 
end  if;  ~  if  bypass(token   semicolon) 

else 

SYNTAX   ERROR("Package  unit"); 
end  if;  —  if  name  statement 

else 

return  (FALSE); 
end  if:  —  if  bypass(token    is) 

end  PACKAGE  UNIT; 


--  PACKAGE  TAIL  END  ->    new  NAME  [GENERIC   ACTUAL  PART  ?]  ; 
-->    [BASIC   DECLARATIVE  ITEM]*   private 

[BASIC   DECLARATIVEITEM]*  ?]  end  [identifier  ?]  ; 
function  PACKAGETAILEND  return  boolean  is 
begin 

put(RESULT_FILE,"In  package  tailend  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN_NEW))  then 
if  (NAME)  then 
if  (GENERICACTUAL   PART)  then 

null; 
end  if;  —  if  generic   actual   part  statement 

if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Package  tail  end"); 
end  if;  —  if  bypass(token   semicolon) 

else 
SYNTAX_ERROR("Package  tail  end"): 
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end  if;  —  if  name  statement 

elsif  (BASIC   DECLARATIVEITEM)  then 
while  (BASICDECLARATIVEJTEM)  loop 

null; 
end  loop; 

if  (BYPASS(TOKEN_PRIVATE))  then 
while  (BASIC   DECLARATIVE  ITEM)  loop 

null; 
end  loop; 
end  if;  ~  if  bypass(token    private) 

if  (BYPASS(TOKEN_END))  then 

HENRY   WRITEENABLE  :=  FALSE; 
if  (BYPASS(TOKEN_IDENTIFIER))  then 

null; 
end  if; 

if  (BYPASS(TOKEN_SEMICOLON))  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  END  PACKAGE  DECLARE, 

NONE,  NEXT   HEN); 
CREATE  NODE(NEXT_HEN,  LAST   RECORD); 
return  (TRUE); 
else 

SYNTAX   ERROR("Package  tail  end"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX  ERRORC'Package  tail  end"); 
end  if;  —  if  bypass(token   end) 

elsif  (BYPASS(TOKEN   PRIVATE))  then 
while  (BASICDECLARATIVEJTEM)  loop 

null; 
end  loop; 

if  (BYPASS(TOKEN   END))  then 
HENRY   WRITE  ENABLE  :=  FALSE; 
if  (BYPASS(TOKEN_IDENTIFIER))  then 

null; 
end  if; 

if  (BYPASS(TOKEN_SEMICOLON))  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  END  PACKAGEDECLARE, 

NONE,  NEXT  HEN); 
CREATE  NODE(NEXT_HEN,  LAST  RECORD); 
return  (TRUE); 
else 

SYNTAX_ERROR("Package  tail  end"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Package  tail  end"); 
end  if;  —  if  bypass(tokenend) 

elsif  (BYPASS(TOKEN_END))  then 
HENRY   WRITE  ENABLE  :=  FALSE; 
if  (BYPASS(TOKEN_IDENTIFIER))  then 

null; 
end  if; 
if  (BYPASS(TOKEN_SEMICOLON))  then 
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WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  END  PACKAGE  DECLARE, 

NONE,  NEXT  HEN); 
CREATE  NODE(NEXT_HEN,  LASTRECORD); 

return  (TRUE); 

else  I 

SYNTAX_ERROR{"Package  tail  end");  '| 

end  if;  —  if  bypass(token   semicolon)  4 

else  \ 

return  (FALSE); 
end  if;  ~  if  bypass(token   new) 

end  PACKAGE  TAIL   END; 


-  BASICDECLARATIVEITEM  ->    BASIC  DECLARATIVE 

-->    REPRESENTATION  CLAUSE 
-->    use  WITH  OR  USE  CLAUSE 
function  BASICDECLARATIVEITEM  return  boolean  is 
begin 

put(RESULT_FILE,  "In  basicdeclarative   item  ");  new   line(RESULT_FILE); 
HENRY   WRITE  ENABLE  :=  TRUE; 
if  (BASIC   DECLARATION)  then 
HENRY   WRITE  ENABLE  :=  FALSE; 
return  (TRUE); 
elsif  (REPRESENTATION   CLAUSE)  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_USE))  then 
if  (WITHORUSECLAUSE)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Basic  declarative  item"); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  BASIC  DECLARATIVE  ITEM; 


-  DECLARATIVE  PART-->    [BASIC  DECLARATIVE  ITEM]*  [LATER  DECLARATIVE  ITEM 
function  DECLARATIVEPART  return  boolean  is 
begm 
put(RESULT   FILE,  "In  declarativepart  ");  new_line(RESULT_FILE); 

while  (BASIC  DECLARATIVE  ITEM)  loop 
null; 

end  loop; 

while  (LATER  DECLARATIVE  ITEM)  loop 
null; 

end  loop; 

return  (TRUE); 
end  DECLARATIVEPART; 
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--  BASIC   DECLARATION  -->    type  TYPE  DECLARATION 
->    subtype  SUBTYPE  DECLARATION 
-->    procedure  PROCEDURE  UNIT 
-->    function  FUNCTIONUNIT 
-->    package  PACKAGE  DECLARATION 
->    generic  GENERICDECLARATION 
-->    IDENTIFIER  DECLARATION 
-->    task  TASK  DECLARATION 
function  BASIC   DECLARATION  return  boolean  is 
begin 

put(RESULT_FILE.  "In  basic   declaration  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN_TYPE))  then 
if  (TYPE  DECLARATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Basic  declaration"); 
end  if; 
elsif  (BYPASS(TOKEN_SUBTYPE))  then 
if  (SUBTYPE  DECLARATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Basic  declaration"); 
end  if; 
elsif  (BYPASS(TOKEN_PROCEDURE))  then 
DECLARE  TYPE  :=  PROCEDURE  DECLARE; 
if  (PROCEDURE   UNIT)  then 
HENRY   VVRITE  ENABLE  :=  FALSE; 

return  (TRUE); 
else 

SYNTAX_ERROR("Basic  declaration"); 
end  if;  —  if  procedure   unit  statement 

elsif  (BYPASS(TOKEN  FUNCTION))  then 
DECLARE  TYPE  ~ FUNCTION  DECLARE; 
if  (FUNCTION  UNIT)  then 
HENRY   WRITE  ENABLE  :=  FALSE; 

return  (TRUE); 
else 

S YNT AX   ERROR("Basic  declaration") ; 
end  if;  —  if  function   unit  statement 

elsif  (BYPASS(TOKEN  PACKAGE))  then 
DECLARE  TYPE  :=  PACKAGE  DECLARE; 
if  (PACKAGE  DECLARATION)  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Basic  declaration"); 
end  if;  —  if  package  declaration 

elsif  (BYPASS(TOKEN_GENERIC))  then 
if  (GENERIC  DECLARATION)  then 

return  (TRUE); 
else 
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SYNTAX_ERROR("Basic  declaration"); 
end  if:  —  if  generic   declaration 

elsif  (IDENTIFIERDECLARATION)  then 
HENRY  WRITEENABLE  :=  FALSE; 
return  (TRUE); 
elsif  (BYPASS(TOKEN_TASK))  then 
DECLARE  TYPE  :=  TASK  DECLARE; 
if  (TASK  DECLARATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Basic  declaration"); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  BASIC   DECLARATION; 


--  LATER  DECLARATIVE  ITEM  -->  PROPER  BODY 

-->    generic  GENERICDECLARATION 
-->    use  WITH  OR  USE  CLAUSE 
function  LATER   DECLARATIVE   ITEM  return  boolean  is 
begin 

put(RESULT_FILE,  "In  later  declarativeitem  ");  new   line(RESULT_FILE); 
if  (PROPERBODY)  then  -  check  for  body   declaration 

return  (TRUE); 
elsif  (BYPASS(TOKEN  GENERIC))  then 
if  (GENERIC   DECLARATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Later  declarative  item"); 
end  if;  —  if  generic   declaration 

elsif  (BYPASS(TOKEN_USE))  then 
if  (WITH  OR  USECLAUSE)  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Later  declarative  item"); 
end  if;  —  if  withoruseclause 

else 

return  (FALSE); 
end  if; 
end  LATER  DECLARATIVE  ITEM; 


--  PROPER   BODY  -->    procedure  PROCEDURE  UNIT 
-->    function  FUNCTION  UNIT 
-->    package  PACKAGE  DECLARATION 
-->    task  TASK  DECLARATION 

function  PROPERBODY  return  boolean  is 

begin 
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put(RESULT_FILE,  "In  proper  body  ");  new   lineiRESULTFILE); 
if  (BYPASS(TOKEN   PROCEDURE))  then  ^ 
DECLARE  TYPE :=  PROCEDUREDECLARE; 
if  (PROCEDURE  UNIT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Proper  body"); 
end  if;  —  if  procedure   unit  statement 

elsif  (BYPASS(TOKEN_FUNCTION))  then 
DECLARE  TYPE  :=  FUNCTIONDECLARE; 
if  (FUNCTION  UNIT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Proper  body"); 
end  if;  —  if  function_unit  statement 

elsif  (BYPASS(TOKEN_PACKAGE))  then 
DECLARE  TYPE   =  PACKAGE  DECLARE; 
if  (PACKAGEDECLARATION)  then 

return  (TRUE); 
else 

SYNTAX  ERROR("Proper  body"); 
end  if;  —  if  packagedeclaration 

elsif  (BYPASS(TOKEN_TASK))  then 
DECLARE  TYPE  :=  TASKDECLARE; 
if  (TASK  DECLARATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Proper  body"); 
end  if; 
else 

return  (FALSE); 
end  if;  —  if  bypass(token   procedure) 

end  PROPER   BODY; 


--  SEQUENCE  OF  STATEMENTS  -->  ISTATEMENTJ  + 
function  SEQUENCE_OF_STATEMENTS  return  boolean  is 
begin 

put(RESULT_FILE,  "In  sequenceofstatements  ");  new_line(RESULT_FILE); 
if  (STATEMENT)  then 
while  (STATEMENT)  loop 

null; 
end  loop; 
return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  SEQUENCE  OF  STATEMENTS; 
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-  STATEMENT  -->    [LABEL  ?|  SIMPLE  STATEMENT 
->    [LABEL  ?1  COMPOUND  STATEMENT 
function  STATEMENT  return  boolean  is 
begin 

put(RESULT   FILE,  "In  statement  ");  new   line(RESULT   FILE); 
if  (LABEL)  then 

null; 
end  if; 
if  (SIMPLESTATEMENT)  then 

return  (TRUE); 
elsif  (COMPOUNDSTATEMENT)  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  STATEMENT; 


-  COMPOUND   STATEMENT  -->    if  IF  STATEMENT 
-->    case  CASE  STATEMENT 
->    LOOP  STATEMENT 
-->    BLOCK  STATEMENT 
->    accept  ACCEPT  STATEMENT 
-->    select  SELECT  STATEMENT 
function  COMPOUND   STATEMENT  return  boolean  is 
begin 

put(RESULT   FILE,  "In  compound   statement  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN  IF))  then 
NESTING   METRIC(IF  CONSTRUCT); 
if  (IFSTATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Compound  statement"); 
end  if;  —  if  if  statement 

elsif  (BYPASS(TOKEN_CASE))  then 
NESTING   METRIC(CASE_CONSTRUCT); 
if  (CASESTATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Compound  statement"); 
end  if;  —  if  case   statement 

elsif  (LOOPSTATEMENT)  then 

return  (TRUE); 
elsif  (BLOCK   STATEMENT)  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_ACCEPT))  then 
if  (ACCEPT  STATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Compound  statement"); 
end  if; 
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elsif  (BYPASS(TOKEN  SELECT))  then 
if  (SELECT  STATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Compound  statement"); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  COMPOUND   STATEMENT; 


--  BLOCK   STATEMENT  -->    [identifier  :  ?]  [declare  DECLARATIVE  PART  ?] 

begin  SEQUENCE  OFSTATEMENTS  [exception 
[EXCEPTIONHANDLERj^  ?|  ?]  end  [identifier  ?|  ; 
function  BLOCK   STATEMENT  return  boolean  is 

DECLARE  STATUS  :  boolean; 
begin 

put(RESULT   FILE,  "In  block  statement  ");  new   line(RESULT_FILE); 
if  (DECLARATION)  then 

DECLARESTATUS  :=  TRUE; 
else 
DECLARATION  :=  TRUE; 
DECLARE  STATUS  :=  FALSE; 
end  if; 

DECLARE  TYPE  :=  BLOCK  DECLARE; 
if  (BYPASS(TOKEN_IDENTIFIER))  then 
SCOPE  LEVEL  :=  SCOPE  LEVEL  +  1; 
if  (BYPASS(TOKEN  COLON))  then 

SCOPE  LEVEL  :=  SCOPE  LEVEL  -  1; 
else 

SYNTAX_ERROR("Block  statement"); 
end  if;  —  if  bypass(token_colon) 

else 

DECLARE  TYPE  :=  VARIABLE  DECLARE; 
end  if;  ~  if  bypass(token   identifier) 

if  (BYPASS(TOKEN_DECLARE))  then 
SCOPE  LEVEL  :=  SCOPE  LEVEL  t  1; 
if  (DECLARATIVE  PART)  then 

null; 
else 

SYNTAX_ERROR("Block  statement"); 
end  if'  —  if  declarative   part  statement 

end  if;  —  if  bypass(token_declare) 

if  (BYPASS(TOKEN  BEGIN))  then 
DECLARATION  :=  FALSE; 
if  (SEQUENCEOFSTATEMENTS)  then 
if  (BYPASS(TOKEN_EXCEPTION))  then 
if  (EXCEPTION  HANDLER)  then 
while  (EXCEPTION  HANDLER)  loop 
null; 
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end  loop; 
else 

SYNTAX_ERROR("Block  statement"); 
end  if;  —  if  exception   handler  statement 

end  if;  ~  if  bypassftoken   exception) 

if  (BYPASS(TOKEN_END))  then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 

null; 
end  if;  ~  if  bypass(token_identifier) 

if  (BYPASS(TOKEN  SEMICOLON))  then 
SCOPE  LEVEL  :=  SCOPE  LEVEL  -  1; 
DECLARATION  :=  TRUE; 
return  (TRUE); 
else 

SYNTAX_ERROR("Block  statement"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Block  statement"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR{"Block  statement"); 
end  if;  ~  if  sequence  of  statements 

else 
if  not  (DECLARESTATUS)  then 

DECLARATION  :=  FALSE; 
end  if; 

return  (FALSE); 
end  if;  —  if  bypass(token   begin) 

end  BLOCK   STATEMENT; 


-  IF  STATEMENT  -->    EXPRESSION  then  SEQUENCE  OF  STATEMENTS 

lelsif  EXPRESSION  then  SEQUENCE  OF  STATEMENTS]* 
[else  SEQUENCEOFSTATEMENTS  ?]  end  if  ; 
function  IF   STATEMENT  return  boolean  is 
begin 

put{RESULT_FILE,  "In  ifstatement  ");  new_lme(RESULT_FILE); 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN_THEN))  then 
if  (SEQUENCEOFSTATEMENTS)  then 
while  (BYPASS(TOKEN_ELSIF))  loop 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN  THEN))  then 
if  not  (SEQUENCEOFSTATEMENTS)  then 

SYNTAX_ERROR("If  statement"); 
end  if;  —  if  not  sequence   of  statements 

else 

SYNTAX_ERROR("If  statement"); 
end  if;  ~  if  bypass(token   then) 

else 
SYNTAX_ERROR("If  statement"); 
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end  if;  —  if  expression  statement 

end  loop; 

if  (BYPASS(TOKEN_ELSE))  then 
if  (SEQUENCEOFSTATEMENTS)  then 

null; 
else 

SYNTAX_ERROR("If  statement"); 
end  if;  —  if  sequence   of  statements 

end  if;  —  if  bypass(token_else) 

if  (BYPASS(TOKEN_END))  then 
if  (BYPASS(TOKEN_IF))  then 
if  (BYPASS(TOKEN  SEMICOLON))  then 
NESTING   METRIC(IF_END); 
return  (TRUE); 
else 

SYNTAX   ERROR("If  statement"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("If  statement"); 
end  if;  —  if  bypass(token    if) 

else 

SYNTAX_ERROR("If  statement"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("If  statement"); 
end  if;  —  if  sequence   of  statements 

else 

SYNTAX_ERROR("If  statement"); 
end  if;  —  if  bypass(token   then) 

else 

return  (FALSE); 
end  if;  --  if  expression  statement 

end  IF  STATEMENT; 


--  CASESTATEMENT  ->    EXPRESSION  is  [CASESTATEMENT   ALTERNATIVE]  +  end  case 
function  CASESTATEMENT  return  boolean  is 
begin 

putfRESULTFILE,  "In  case  statement  ");  new_line(RESULT_FILE); 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN  IS))  then 
if  (CASESTATEMENTALTERNATIVE)  then 
while  (CASE  STATEMENT   ALTERNATIVE)  loop 

null; 
end  loop; 

if  (BYPASS(TOKEN  END))  then 
if  (BYPASS(TOKEN  CASE))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 
NESTING   METRIC(CASE  END); 
return  (TRUE); 
else 
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SYNTAX_ERROR("Case  statement"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Case  statement"): 
end  if;  —  if  bypass(token_case) 

else 

SYNTAX_ERROR("Case  statement"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("Case  statement"); 
end  if;  ~  if  case   statement   alternative 

else 

SYNTAX_ERROR("Case  statement"); 
end  if;  —  if  bypass(token   is) 

else 

return  (FALSE); 
end  if;  —  if  expression  statement 

end  CASE  STATEMENT; 


-  CASE  STATEMENT   ALTERNATIVE -->    when  CHOICE  [|  CHOICE]*  => 

SEQUENCE  OF  STATEMENTS 
function  CASESTATEMENTALTERNATIVE  return  boolean  is 
begin 

put(RESULT   FILE,  "In  casestatementalternative  ");  new   line(RESULT_FILE); 
if  (BYPASS(TOKEN   WHEN))  then 
if  (CHOICE)  then 
while  (BYPASS(TOKEN_BAR))  loop 
if  not  (CHOICE)  then 

SYNTAX_ERROR("Case  statement  alternative"); 
end  if;  —  if  not  choice  statement 

end  loop; 

if  (BYPASS(TOKEN_ARROW))  then 
if  (SEQUENCEOFSTATEMENTS)  then 

return  (TRUE); 
else 

SYNTAX    ERROR("Case  statement  alternative"); 
end  if;  —  if  sequence   of  statements 

else 

SYNTAX_ERROR("Case  statement  alternative"); 
end  if;  --  if  bypass(token   arrow) 

else 

SYNTAX_ERROR("Case  statement  alternative"); 
end  if;  —  if  choice  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   when) 

end  CASE  STATEMENT   ALTERNATIVE; 
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-  LOOPSTATEMENT  ->    [identifier  :  ?i  [ITERATION  SCHEME  ?]  loop 

SEQUENCEOF  STATEMENTS  end  loop  [identifier  ?|  ; 
function  LOOPSTATEMENT  return  boolean  is 
begin 

put(RESULT_FILE,  "In  loopstatement  ");  new   line(RESULT_FILE); 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
if  (BYPASS(TOKEN_COLON))  then 

null; 
else 

SYNTAX_ERROR("Loop  statement"); 
end  if;  —  if  bypass(token   colon) 

end  if;  -  if  bypass(token   identifier) 

if  (ITERATIONSCHEME)  then 

NO   ITERATION  :=  FALSE; 
end  if;  —  if  iteration   scheme  statement 

if  (BYPASS(TOKEN_LOOP))  then 
if  (NO   ITERATION)  then 

NESTING   METRIC(LOOP_CONSTRUCT); 
else 

NO   ITERATION  :=  TRUE; 
end  if; 

if  (SEQUENCEOF   STATEMENTS)  then 
if  ( BYPASS  (TOKENEND))  then 
if  (BYPASS(TOKEN_LOOP))  then 
if  (BYPASS(TOKEN_IDENTIFIER))  then 

null; 
end  if;  ~  if  bypass(token   identifier) 

if  (BYPASS(TOKEN  SEMICOLON))  then" 
NESTING   METRIC(LOOP  END); 
return  (TRUE); 
else 

SYNTAX_ERROR("Loop  statement"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Loop  statement"); 
end  if;  ~  if  bypass(token   loop) 

else 

SYNTAX_ERROR("Loop  statement"); 
end  if;  ~  if  bypass(token   end) 

else 

SYNTAX_ERROR("Loop  statement"); 
end  if;  —  if  sequence   of  statements 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   loop) 

end  LOOP   STATEMENT; 


--  EXCEPTION  HANDLER  -->    when  EXCEPTION  CHOICE  [:  EXCEPTION  CHOICE]*  => 

SEQUENCE  OF  STATEMENTS 
function  EXCEPTION   HANDLER  return  boolean  is 
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begin 

put(RESULT_FILE,  "In  exceptionhandler  ");  new   line(RESULT_FILE); 
if  (BYPASSfTOKEN   WHEN))  then 
if  (EXCEPTIONCHOICE)  then 
while  (BYPASS(TOKEN_BAR))  loop 
if  not  (EXCEPTIONCHOICE)  then 

SYNTAX_ERROR{"Exception  handler"); 
end  if;  —  if  not  exception   choice 

end  loop; 

if  (BYPASS(TOKEN  ARROW))  then 
if  (SEQUENCEOFSTATEMENTS)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Exception  handler"); 
end  if;  —  if  sequence   of  statements 

else 

SYNTAX_ERROR("Exception  handler"); 
end  if;  —  if  bypass(tokenarrow) 

else 

SYNTAX  ERROR("Exception  handler"); 
end  if;  —  if  exception   choice  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token-when) 

end  EXCEPTION   HANDLER; 


-  ACCEPT  STATEMENT  -->    identifier  [(EXPRESSION)  ?]  iFORMAL   PART  ?) 

[do  SEQUENCEOFSTATEMENTS  end  [identifier  ?[  ?]  ; 
function  ACCEPTSTATEMENT  return  boolean  is 
begin 

put(RESULT   FILE,  "In  accept  statement  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN_IDENTIFIER))  then 
if  (BYPASS(TOKEN_LEFT_PAREN))  then 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN_RIGHT_PAREN))  then 

null; 
else 

SYNTAX_ERROR(" Accept  statement"); 
end  if;  —  if  bypass(token   right   paren) 

else 

SYNTAX_ERROR(" Accept  statement"); 
end  if;  —  if  expression  statement 

end  if;  --  if  bypass(token_left_paren) 

if  (FORMAL   PART)  then 

null; 
end  if;  --  if  formal   part  statement 

if  (BYPASS(TOKEN_DO))  then 
if  (SEQUENCEOFSTATEMENTS)  then 
if  (BYPASS(TOKEN_END))  then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
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null; 
end  if;  ~  if  bypass(token   identifier) 

else 

SYNTAX_ERROR(" Accept  statement"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR(" Accept  statement"); 
end  if;  —  if  sequence   of  statements 

end  if;  ~  if  bypass(token   do) 

if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR(" Accept  statement"): 
end  if;  —  if  bypass(token   semicolon) 

else 

return  (FALSE); 
end  if;  ~  if  bypass(token   identifier) 

end  ACCEPT  STATEMENT; 


--  SELECT  STATEMENT  ->    SELECT  STATEMENT  TAIL   SELECT  ENTRY  CALL  end  select 
function  SELECT  STATEMENT  return  boolean  is 
begin 

put(RESULT   FILE,  "In  selectstatement  ");  new_line(RESULT_FILE); 
if  (SELECT  STATEMENT  TAIL)  then 
if  (SELECT  ENTRY  CALL)  then 
if  (BYPASS(TOKEN_END))  then 
if  (BYPASS(TOKEN  SELECT))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Select  statement"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Select  statement"); 
end  if;  —  if  bypass(token   select) 

else 

SYNTAX_ERROR("Select  statement"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("Select  statement"); 
end  if;  ~  if  select   entry   call  statement 

else 

return  (FALSE); 
end  if;  —  if  select   statement   tail 

end  SELECT  STATEMENT; 


SELECT  STATEMENT  TAIL  ->    SELECT  ALTERNATIVE  |or  SELECT  ALTERNATIVE]* 
->    NAME  ;  [SEQUENCE  OFSTATEMENTS  ?] 
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function  SELECTSTATEMENTTAIL  return  boolean  is 
begin 

put(RESULT_FILE,  "In  selectstatementtail  ");  new_line(RESULT_FILE); 
if  (SELECTALTERNATIVE)  then 
while  (BYPASS(TOKEN_OR))  loop 
if  not  (SELECTALTERNATIVE)  then 

SYNTAX_ERROR("Select  statement  tail"); 
end  if; 
end  loop; 
return  (TRUE); 
elsif  (NAME)  then  —  check  for  entry  call  statement 

if  (BYPASS(TOKEN_SEMICOLON))  then 
if  (SEQUENCEOFSTATEMENTS)  then 

null; 
end  if;  —  if  sequence   of  statements 

return  (TRUE); 
else 

SYNTAX_ERROR("Select  statement  tail"); 
end  if;  —  if  bypass(token   semicolon) 

else 

return  (FALSE); 
end  if;  —  if  selectalternative  statement 

end  SELECT  STATEMENT  TAIL; 


--  SELECTALTERNATIVE  -->    [when  EXPRESSION  =>  ?]  accept  ACCEPT  STATEMENT 

[SEQUENCE  OF  STATEMENTS  ?| 
-->    [when  EXPRESSION  =>  ?|  delay  DELAY   STATEMENT 

[SEQUENCE  OF  STATEMENTS  ?| 
-->    [when  EXPRESSION  =>  ?|  terminate  ; 
function  SELECTALTERNATIVE  return  boolean  is 
begin 

put(RESULT_FILE,  "In  selectalternative  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN_WHEN))  then 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN_ARROVV))  then 

null; 
else 

SYNTAX_ERROR("Select  alternative"); 
end  if;  —  if  bypass(token   arrow) 

else 

SYNTAX_ERROR("Select  alternative"); 
end  if;  —  if  expression  statement 

end  if;  —  if  bypass(token   when) 

if  (BYPASS(TOKEN  ACCEPT))  then 
if  (ACCEPT  STATEMENT)  then 
if  (SEQUENCEOFSTATEMENTS)  then 

null; 
end  if;  ~  if  sequence   of  statements 

return  (TRUE); 
else 
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SYNTAX_ERROR("Select  alternative"); 
end  if;  —  if  accept   statement 

elsif  (BYPASS(TOKEN_DELAY))  then 
if  (DELAYSTATEMENT)  then 
if  (SEQUENCEOFSTATEMENTS)  then 

null; 
end  if;  —  if  sequence   of  statements 

return  (TRUE); 
else 

SYNTAX_ERROR("Select  alternative"); 
end  if;  —  if  delay   statement 

elsif  (BYPASS(TOKEN  TERMINATE))  then 
if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Select  alternative"); 
end  if;  —  if  bypass(token   semicolon) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   accept) 

end  SELECT   ALTERNATIVE; 


-  SELECT  ENTRYCALL  ->    else  SEQUENCE  OFSTATEMENTS 

-->    or  delay  DELAYSTATEMENT  [SEQUENCE  OF  STATEMENTS  ?] 
function  SELECT  ENTRYCALL  return  boolean  is 
begin 

put(RESULT_FILE,  "In  select   entry   call  ");  new   line(RESULT   FILE); 
if  (BYPASS(TOKEN_ELSE))  then 
if  (SEQUENCE  OF  STATEMENTS)  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Select  entry  call"); 
end  if;  —  if  sequence   of  statements 

elsif  (BYPASS(TOKEN_OR))  then 
if  (BYPASS(TOKEN  DELAY))  then 
if  (DELAY   STATEMENT)  then 
if  (SEQUENCEOFSTATEMENTS)  then 

null; 
end  if;  —  if  sequence   of  statements 

return  (TRUE); 
else 

SYNTAX_ERROR("Select  entry  call"); 
end  if;  —  if  delaystatement 

else 

SYNTAX   ERROR("Select  entry  call"); 
end  if;  ~  if  bypass(token_delay) 

else 

return  (FALSE); 
end  if;  --  if  bypass(token   else) 

end  SELECTENTRY   CALL; 

137 


end  PARSER    1; 


-  TITLE:  AN  ADA  SOFTWARE  METRIC 

-  MODULE  NAME:      PACKAGE  PARSER  2 
--    DATE  CREATED:     18  JUL  86 

--    LAST  MODIFIED:    30  MAY  87 

--    AUTHORS:  LCDR  JEFFREY  L.  NIEDER 

LT  KARL  S   FAIRBANKS,  JR. 
LCDR  PAUL  M.  HERZIG 

-  DESCRIPTION:    This  package  contains  thirty-three  functions 

that  are  the  middle  level  productions  for  our  top-down, 
recursive  descent  parser.    Each  function  is  preceded 
by  the  grannmaar  productions  they  are  implementing. 

with  PARSER  3,  PARSER  4,  HENRY  GLOBAL,  HENRY,  BYPASS  FUNCTION, 
BYPASS  SUPPORT  FUNCTIONS,  GLOBAL  PARSER,  GLOBAL,  TEXT  10; 
use  PARSER  3,  PARSER  4,  HENRY  GLOBAL,  HENRY,  BYPASS  FUNCTION, 
BYPASS  SUPPORTFUNCTIONS,  GLOBALPARSER,  GLOBAL,  TEXT  10; 

package  PARSER   2  is 
IDENT   DECLARE  :  BOOLEAN  :=  FALSE; 
function  GENERIC   ACTUAL   PART  return  boolean; 
function  GENERIC   ASSOCIATION  return  boolean; 
function  GENERICFORMAL   PARAMETER  return  boolean; 
function  GENERIC   TYPE  DEFINITION  return  boolean; 
function  PRIVATETYPE   DECLARATION  return  boolean; 
function  TYPE   DECLARATION  return  boolean; 
function  SUBTYPEDECLARATION  return  boolean; 
function  DISCRIMINANTPART  return  boolean; 
function  DISCRIMINANT  SPECIFICATION  return  boolean; 
function  TYPEDEFINITION  return  boolean; 
function  RECORDTYPE   DEFINITION  return  boolean; 
function  COMPONENT   LIST  return  boolean; 
function  COMPONENT  DECLARATION  return  boolean; 
function  VARIANT   PART  return  boolean; 
function  VARIANT  return  boolean; 
function  WITH   OR   USECLAUSE  return  boolean; 
function  FORMAL   PART  return  boolean; 
function  IDENTIFIER  DECLARATION  return  boolean; 
function  IDENTIFIERDECLARATIONTAIL  return  boolean; 
function  EXCEPTIONTAIL  return  boolean; 
function  EXCEPTIONCHOICE  return  boolean; 
function  CONSTANTTERM  return  boolean; 
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function  IDENTIFIERTAIL  return  boolean; 
function  PARAMETERSPECIFICATION  return  boolean; 
function  IDENTIFIERLIST  return  boolean; 
function  MODE  return  boolean; 
function  DESIGNATOR  return  boolean; 
function  SIMPLESTATEMENT  return  boolean; 
function  ASSIGNMENTOR   PROCEDURE  CALL  return  boolean; 
function  LABEL  return  boolean; 
function  ENTRYDECLARATION  return  boolean; 
function  REPRESENTATION  CLAUSE  return  boolean; 
function  RECORD   REPRESENTATIONCLAUSE  return  boolean; 
end  PARSER  2; 


package  body  PARSER   2  is 

-  GENERIC   ACTUAL  PART  ->    (GENERIC   ASSOCIATION  |,  GENERIC   ASSOCIATION]* 
function  GENERICACTUAL   PART  return  boolean  is 
begin 
if  (BYPASS(TOKEN   LEFT  PAREN))  then 
if  (GENERIC   ASSOCIATION)  then 
while  (BYPASS(TOKEN  COMMA))  loop 
if  not  (GENERIC    ASSOCIATION)  then 

SYNTAX_ERROR("Generic  actual  part"); 
end  if;  —  if  not  generic   association 

end  loop; 
if  (BYPASS(TOKEN   RIGHT  PAREN))  then 

return  (TRUE); 
else 

SYNTAX_ERROR( "Generic  actual  part"); 
end  if;  —  if  bypass(token_rightparen) 

else 

SYNTAX_ERROR("Generic  actual  part"); 
end  if;  —  if  generic  association  statement 

else 

return(FALSE); 
end  if;  —  if  bypass(tokenleftparen) 

end  GENERIC   ACTUAL  PART; 


-  GENERIC   ASSOCIATION  -->    [GENERIC  FORMAL  PARAMETER  ?]  EXPRESSION 
function  GENERICASSOCIATION  return  boolean  is 
begin 
if  (GENERIC   FORMAL  PARAMETER)  then 

null; 
end  if;  —  if  generic   formal   parameter  statement 

if  (EXPRESSION)  then  --  check  for  genericactualparameter 

return  (TRUE); 
else 
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return  (FALSE); 
end  if;  —  if  expression 

end  GENERIC   ASSOCIATION; 


-  GENERIC   FORMAL   PARAMETER  -->    identifier  => 

—  >    string   literal  => 
function  GENERIC   FORMAL   PARAMETER  return  boolean  is 
begin 
LOOK   AHEAD  TOKEN  :-  TOKEN  RECORD   BLFFER(TOKEN  ARRAY  INDEX  +  1); 
if  (ADJUST  LEXEME(LOOK  AHEAD  TOKEN. LEXEME, 

LOOK   AHEAD  TOKEN. LEXEME  SIZE-  1)  =  "  =  >")  then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
if  (BYPASS(TOKEN_ARROW))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Generic  formal  parameter"); 
end  if;  —  if  bypass(token    arrow) 

elsif(BYPASS(TOKEN   STRING   LITERAL))  then 
if  (BYPASS(TOKEN_ARROW))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  formal  parameter"); 
end  if;  —  if  bypass(token   arrow) 

else 

SYNTAX_ERROR("Generic  formal  parameter"); 
end  if;  —  if  bypass(token   identifier) 

else 

return  (FALSE); 
end  if;  —  if  adjust   lexeme(lookahead   token) 

end  GENERIC  FORMAL   PARAMETER;" 


-  GENERICTYPEDEFINITION  -->    (  <>  ) 

—  >  range  <> 
->  digits  <> 
-->    delta  <> 

->    array  ARRAY  TYPE  DEFINITION 
-->    access  SUBTYPE  INDICATION 
function  GENERIC  TYPEDEFINITION  return  boolean  is 
begin 
if  (BYPASS(TOKEN_LEFT_PAREN))  then 
if  (BYPASS(TOKEN_BRACKETS))  then 
if  (BYPASS(TOKEN_RIGHT_PAREN))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  type  definition"); 
end  if;  —  if  bypass(token   right   paren) 

else 
SYNTAX   ERROR("Generic  type  definition"); 
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end  if;  —  if  bypass(token   brackets) 

elsif  (BYPASS(TOKEN   RANGE))  or  else  (BYPASS(TOKEN   DIGITS)) 
or  else  (BYPASS(TOKEN_DELTA))  then 
if  (BYPASS(TOKEN_BRACKETS))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Generic  type  definition"); 
end  if;  —  if  bypass(token   brackets) 

elsif  (BYPASS(TOKEN_ARRAY))  then 
if  (ARRAY   TYPE  DEFINITION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Generic  type  definition"); 
end  if;  —  if  array   type  definition 

elsif  (BYPASS(TOKEN_ACCESS))  then 
if  (SUBTYPEINDICATION)  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Generic  type  definition"); 
end  if;  —  if  subtype   indication 

else 

return  (FALSE); 
end  if;  —  if  bypass  (token   left   paren) 

end  GENERIC  TYPE  DEFINITION; 


--  PRIVATE  TYPEDECLARATION  -->    [limited  ?[  private 
function  PRIVATE  TYPE  DECLARATION  return  boolean  is 
begin 
if  (BYPASS(TOKEN_LIMITED))  then 

null; 
end  if; 
if  (BYPASS(TOKEN_PRIVATE))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  PRIVATE  TYPE  DECLARATION; 


-  SUBTYPE  DECLARATION  -->    identifier  is  SUBTYPEINDICATION  ; 
function  SUBTYPE  DECLARATION  return  boolean  is 
begin 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
if  (BYPASS(TOKEN_IS))  then 
if  (SUBTYPEINDICATION)  then 
if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 
SYNTAX_ERROR("Subtype  declaration"); 
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end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Subtype  declaration"); 
end  if;  —  if  subtype   indication  statement 

else 

SYNTAX_ERROR("Subtype  declaration"); 
end  if;  —  if  bypass(token   is) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   identifier) 

end  SUBTYPE  DECLARATION; 


--  TYPE  DECLARATION  -->    identifier  [DISCRIMINANT  PART  ?] 

is  SUBTYPE  INDICATION; 
function  TYPEDECLARATION  return  boolean  is 
begin 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
if  (DISCRIMINANT  PART)  then 

null; 
end  if;  ~  if  discriminant   part  statement 

if  (BYPASS(TOKEN  JS))  then  --  declaration  is  fuUtype  if  'is' 

if  (PRIVATE  TYPEDECLARATION)  then 

null; 
elsif  (TYPE  DEFINITION)  then        ~      present,  otherwise  incomplete  type 

null; 
else 

SYNTAX_ERROR("Type  declaration"); 
end  if;  —  if  type   definition  statement 

end  if;  —  if  bypass(token   is) 

if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Type  declaration"); 
end  if;  —  if  bypass(token_semicolon) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   identifier) 

end  TYPE  DECLARATION; 


-  DISCRIMINANT  PART  ->    (DISCRIMINANT  SPECIFICATION 

1;  DISCRIMINANTSPECIFICATION]*  ) 
function  DISCRIMINANTPART  return  boolean  is 
begin 
if  (BYPASS(TOKEN   LEFTPAREN))  then 
if  (DISCRIMINANT  SPECIFICATION)  then 
while  (BYPASS(TOKEN_SEMICOLON))  loop 
if  not  (DISCRIMINANT   SPECIFICATION)  then 
SYNTAX_ERROR("Discriminant  part"); 
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end  if;  —  if  not  discriminant   specification 

end  loop; 
if  (BYPASS(TOKEN_RIGHT_PAREN))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Discriminant  part"); 
end  if;  —  if  bypass(token   right   paren) 

else 

SYNTAX_ERROR("Discriminant  part"); 
end  if;  —  if  discriminant   specification 

else 

return  (FALSE); 
end  if;  --  if  bypass  (token   left   paren) 

end  DISCRIMINANT  PART; 


-  DISCRIMINANT  SPECIFICATION  ->    IDENTIFIER  LIST  :  NAME    =  EXPRESSION  ?) 
function  DISCRIMINANT  SPECIFICATION  return  boolean  is 
begin 
if  (IDENTIFIER   LIST)  then 
if  (BYPASS(TOKEN_COLON))  then 
if  (NAME)  then  -  check  for  type   mark 

if  (BYPASS(TOKEN_ASSIGNMENT))  then 
if  (EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Discriminant  specification"); 
end  if;  —  if  expression  statement 

end  if;  —  if  bypass(token   assignment) 

return  (TRUE); 
else 

SYNTAX_ERROR("Discriminant  specification"); 
end  if;  ~  if  name  statement 

else 

SYNTAX_ERROR("Discriminant  specification"); 
end  if;  ~  if  bypass(token   colon) 

else 

return  (FALSE); 
end  if;  ~  if  identifier   list  statement 

end  DISCRIMINANT  SPECIFICATION; 


--  TYPE  DEFINITION -->    ENUMERATION  TYPE  DEFINITION 

->  INTEGER  TYPE  DEFINITION 

->  digits  FLOATING   OR   FIXED  POINT  CONSTRAINT 

->  delta  FLOATINGOR  FIXED  POINT  CONSTRAINT 

->  array  ARRAY  TYPE  DEFINITION 

->  record  RECORD  TYPE  DEFINITION 

->  access  SUBTYPE  INDICATION 

->  new  SUBTYPE  INDICATION 
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function  TYPEDEFINITION  return  boolean  is 
begin 
if  (ENUMERATION  TYPE  DEFINITION)  then 

return  (TRUE); 
elsif  (INTEGER  TYPEDEFINITION)  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN  DIGITS))  or  else  (BYPASS(TOKEN  DELTA))  then 
if  (FLOATING   OR  FIXED  POINT  CONSTRAINT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Type  definition"); 
end  if;  —  floating   or   fixed   point   constraint 

elsif  (BYPASS(TOKEN_ARRAY))  then 
if  (ARRAY  TYPE  DEFINITION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Type  definition"); 
end  if;  —  if  array    type   definition 

elsif  (BYPASS(TOKEN_RECORD_STRUCTURE)')  th^n 
if  (RECORD  TYPEDEFINITION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Type  definition"); 
end  if;  —  if  recordtypedefinition 

elsif  (BYPASS(TOKEN_ACCESS))  or  else  (BYPA"SS(T0KEN_NEW))  then 
if  (SUBTYPE   INDICATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Type  definition"); 
end  if;  —  if  subtype   indication 

else 

return  (FALSE); 
end  if; 
end  TYPE  DEFINITION; 


-  RECORD  TYPE  DEFINITION  -->    COMPONENT  LIST  end  record 
function  RECORD  TYPEDEFINITION  return  boolean  is 
begin 
if  (COMPONENT  LIST)  then 
if  (BYPASS(TOKEN_END))  then 
if  (BYPASS(TOKEN_RECORD   STRUCTURE))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Record  type  definition"); 
end  if;  ~  if  bypass(token   record-structure) 

else 

SYNTAX_ERROR("Record  type  definition"); 
end  if;  —  if  bypass(token   end) 

else 
return  (FALSE); 

144 


end  if;  —  if  component   list  statement 

end  RECORD   TYPE  DEFINITION; 


--  COMPONENT  LIST  -->    (COMPONENT  DECLARATION]*  [VAARIANTPART  ?| 

-->    null  ; 
function  COMPONENT  LIST  return  boolean  is 
begin 
while  (COMPONENT  DECLARATION)  loop 

null; 
end  loop; 
if  (VARIANT   PART)  then 

null; 
elsif  (BYPASS(TOKEN_NULL))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

null; 
end  if; 
end  if; 

return  (TRUE); 
end  COMPONENT   LIST; 


--  COMPONENT  DECLARATION  ->    IDENTIFIER  LIST  :  SUBTYPE  INDICATION 

1:=  EXPRESSION  ?i  ; 
function  COMPONENTDECLARATION  return  boolean  is 
begin 
if  (IDENTIFIERLIST)  then 
if  (BYPASS(TOKEN   COLON))  then 
if  (SUBTYPE  INDICATION)  then 
if  (BYPASS(TOKEN   ASSIGNMENT))  then 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Component  declaration"); 
end  if;  —  if  bypass(token_semicolon) 

else 

SYNTAX_ERROR("Component  declaration"); 
end  if;  ~  if  expression  statement 

end  if;  —  if  bypass(token   assignment) 

if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Component  declaration"); 
end  if;  ~  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Component  declaration"); 
end  if;  —  if  subtype   indication  statement 

else 
SYNTAX_ERROR("Component  declaration"); 
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end  if;  —  if  bypass(token   colon) 

else 

return  (FALSE); 
end  if;  —  if  identifier   list  statement 

end  COMPONENT   DECLARATION; 


--  VARIANTPART  -->    case  identifier  is  [VARIANT1+  ^"^  case  ; 
function  VARIANTPART  return  boolean  is 
begin 
if  (BYPASS(TOKEN_CASE))  then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
if  (BYPASS(TOKEN  JS))  then 
if  (VARIANT)  then 
while  (VARIANT)  loop 

null: 
end  loop; 

if  (BYPASS(TOKEN  END))  then 
if  (BYPASS(TOKEN  CASE))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Variant  part"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Variant  part"); 
end  if;  --  if  bypass(token   case) 

else 

SYNTAX_ERROR("Variant  part"); 
end  if;  —  if  bypass(token   end) 

else 

SYNTAX_ERROR("Variant  part"); 
end  if;  —  if  variant  statement 

else 

SYNTAX_ERROR("Variant  part"); 
end  if;  --  if  bypass(token   is) 

else 

SYNTAX_ERROR(" Variant  part"); 
end  if;  --  if  bypass(token   identifier) 

else 

return  (FALSE); 
end  if;  ~  if  bypass(token   case) 

end  VARIANT  PART; 


--  VARIANT  -->   when  CHOICE  [   CHOICE]*  =>  COMPONENT  LIST 
function  VARIANT  return  boolean  is 
begin 

if  (BYPASS(TOKEN_WHEN))  then 
if  (CHOICE)  then 
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while  (BYPASS(TOKEN_BAR))  loop 
if  not  (CHOICE)  then 

SYNTAX_ERROR("Variant"); 
end  if;  —  if  not  choice  statement 

end  loop; 

if  (BYPASS(TOKEN_ARROW))  then 
if  (COMPONENT  LIST)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Variant"); 
end  if;  —if  component   list  statement 

else 

SYNTAX_ERROR("Variant"); 
end  if;  —  if  bypass(token   arrow) 

else 

SYNTAX_ERROR("Variant"); 
end  if;  ~  if  choice  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   when) 

end  VARIANT; 


--  WITH   OR   USE  CLAUSE ->    identifier  [,  identifier]*  ; 
function  WITH   ORUSECLAUSE  return  boolean  is 
begin 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
while  (BYPASS(TOKEN_COMMA))  loop 
if  not  (BYPASS(TOKEN  IDENTIFIER))  then 

SYNTAXERRORC'With  or  use  clause"); 
end  if; 
end  loop; 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAXERRORC'With  or  use  clause"); 
end  if;  —  if  bypass(token   semicolon] 

else 

return  (FALSE); 
end  if;  —  if  bypass(token    identifier) 

end  WITH  OR   USE  CLAUSE; 


-  FORMAL  PART  ->    (PARAMETER  SPECIFICATION  [;  PARAMETER   SPECIFICATION! 
function  FORMAL   PART  return  boolean  is 
begin 
if  (BYPASS(TOKEN   LEFTPAREN))  then 
FORMAL   PARAM   DECLARE  :=  TRUE; 
if  (PARAMETERSPECIFICATION)  then 
while  (BYPASS(TOKEN_SEMICOLON))  loop 
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if  not  (PARAMETER  SPECIFICATION)  then 

SYNTAXERRORC'Formal  part"); 
end  if;  —  if  not  parameter  specification  statement 

end  loop; 

if  (BYPASS(TOKEN  RIGHT  PAREN))  then 
if  PACKAGE  BODY  DECLARE  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  END  PARAM  DECLARE, 

NONE,  NEXT  HEN); 
CREATE  NODE(NEXT  HEN,  LAST  RECORD); 
end  if; 

FORMAL   PARAM  DECLARE  :=  FALSE; 
return  (TRUE); 
else 

SYNTAXERRORC'Formal  part"); 
end  if;  —  if  bypass(token_right_paren)  statement 

else 

SYNTAXERRORC'Formal  part"); 
end  if;  —  if  parameter   specification  statement 

else 

return  (FALSE); 
end  if:  —  if  bypass(token    left   paren)  statement 

end  FORMAL   PART; 


-  IDENTIFIER   DECLARATION ->    IDENTIFIER   LIST  :  IDENTIFIER  DECLARATION  TA 
function  IDENTIFIERDECLARATION  return  boolean  is 
begin 

put(RESULT  FILE,  "IN  IDENTIFIER  DECLARATION");  NEW   LINE(RESULT   FILE); 
HENRY   WRITE  ENABLE  :=  TRUE; 
IDENT   DECLARE  :=  TRUE; 
if  (IDENTIFIERLIST)  then 
if  (BYPASS(TOKEN   COLON))  then 
if  (IDENTIFIER  DECLARATION  TAIL)  then 
HENRY   WRITE  ENABLE   =  FALSE; 

return  (TRUE); 
else 

SYNTAX  ERROR("Identifier  declaration"); 
end  if;  ~  if  identifier  list  statement 

else 

SYNTAXERRORC'Identifier  declaration"); 
end  if;  —  if  bypass(token   colon) 

else 

return(FALSE); 
end  if;  —  if  identifier  list  statement 

end  IDENTIFIER  DECLARATION; 


-  IDENTIFIER  DECLARATIONTAIL  -->    exception  EXCEPTIONTAIL 

->    constant  CONSTANT  TERM 
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-->    array  ARRAY  TYPE  DEFINITION 

[:=  EXPRESSION  ■"]  ; 
-->    NAME   IDENTIFIER  TAIL 
function  IDENTIFIERDECLARATION  TAIL  return  boolean  is 
begin 

put(RESULT  FILE,  "IN  IDENTIFIER  DECLARATION  TAIL");  NEW  LINE(RESULT_FILE); 
if  (BYPASS(TOKEN_EXCEPTION))  then 
if  (EXCEPTION  TAIL)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Identifier  declaration  tail"); 
end  if;  —  if  exception  tail  statement 

elsif  (BYPASS(TOKEN_CONSTANT))  then 
if  (CONSTANT  TERM)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Identifier  declaration  tail"); 
end  if;  —  if  constant   term  statement 

elsif  (BYPASS(TOKEN   ARRAY))  then 
if  (ARRAY  TYPE  DEFINITION)  then 
if  (BYPASS(TOKEN   ASSIGNMENT))  then 
if  (EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Identifier  declaration  tail"); 
end  if;  —  if  expression  statement 

end  if;  —  if  bypass(token   assignment) 

else 

SYNTAX_ERROR("Identifier  declaration  tail"); 
end  if;  ~  if  array   typedefinition 

if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Identifier  declaration  tail"); 
end  if;  —  if  bypass(token   semicolon) 

elsif  (NAME)  then 
if  (IDENTIFIERTAIL)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Identifier  declaration  tail"); 
end  if;  —  if  identifier   tail 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   exception) 

end  IDENTIFIER  DECLARATION  TAIL; 


-  EXCEPTIONTAIL  -->    ; 

-->    renames  NAME  ; 
function  EXCEPTIONTAIL  return  boolean  is 
begin 
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if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_RENAMES))  then 
if  (NAME)  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAXERRORC'Exception  tail"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAXERRORC'Exception  tail"); 
end  if;  —  if  name  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token_semicolon) 

end  EXCEPTION  TAIL; 


-  EXCEPTION  CHOICE  -->    identifier 

— >    others 
function  EXCEPTIONCHOICE  return  boolean  is 
begin 
if  (BYPASS(TOKEN_IDENTIFIER))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN  OTHERS))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  EXCEPTION  CHOICE; 


--  CONSTANT  TERM  -->    array  ARRAY  TYPE  DEFINITION  [:=  EXPRESSION  ?| 
-->    :=  EXPRESSION  ; 
-->    NAME   IDENTIFIER  TAIL 
function  CONSTANTTERM  return  boolean  is 
begin 
if  (BYPASS(TOKEN_ARRAY))  then 
if  (ARRAY  TYPEDEFINITION)  then 
if  (BYPASS(TOKEN_ASSIGNMENT))  then 
if  (EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Constant  term"); 
end  if;  —  if  expression  statement 

end  if;  ~  if  bypass(token   assignment) 

else 

SYNTAX_ERROR("Constant  term"); 
end  if;  —  if  array   type  definition 

if  (BYPASS(TOKEN_SEMICOLON))  then 
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return  (TRUE); 
else 

SYNTAX_ERROR("Constant  term"); 
end  if;  ~  if  bypass(token   semicolon) 

elsif  (BYPASS(TOKEN_ASSIGNMENT))  then 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN   SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Constant  term"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Constant  term"); 
end  if;  —  if  expression  statement 

elsif  (NAME)  then 
if  (IDENTIFIERTAIL)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Constant  term"); 
end  if;  —  if  identifier   tail  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   array) 

end  CONSTANT  TERM; 


-  IDENTIFIER  TAIL  -->    (CONSTRAINT  ?j  |:=  EXPRESSION  ?]  ; 
-->    [renames  NAME  ?!  ; 
function  IDENTIFIERTAIL  return  boolean  is 
begin 

put(RESULT  FILE,  "IN  IDENTIFIER  TAIL");  NEW   LINE(RESULT  FILE); 
if  (CONSTRAINT)  then 

null; 
end  if;  —  if  constraint  statement 

if  (BYPASS(TOKEN_RENAMES))  then 
if  (NAME)  then 

null; 
else 

SYNTAX_ERROR("Identifier  tail"); 
end  if;  —  if  name  statement 

end  if;  —  if  bypass(token   renames) 

if  (BYPASS(TOKEN_ASSIGNMENT))  then 
if  (EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Identifier  tail"); 
end  if;  --  if  expression  statement 

end  if;  —  if  bypass(token   assignment) 

if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 
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return  (FALSE); 
end  if;  ~  if  bypass(token   semicolon) 

end  IDENTIFIER  TAIL; 


-  PARAMETER  SPECIFICATION  -->    IDENTIFIER  LIST  :  MODE   NAME  [:=  EXPRESSION  ?| 
function  PARAMETER   SPECIFICATION  return  boolean  is 
begin 

put(RESULT_FILE,  "IN  PARAMETER  SPECIFICATION");  NEVV_LINE(RESULT_FILE); 
HENRY   WRITE  ENABLE  :=  TRUE;    --to  capture  first  parameter 
if   (IDENTIFIERLIST)  then 
if  (BYPASS(TOKEN_COLON))  then 
if  (xMODE)  then 
if  (NAME)  then  ~  check  for  typemark 

if  (BYPASS(TOKEN   ASSIGNMENT))  then 
if  (EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Parameter  specification"); 
end  if;  —  if  expression  statement 

end  if;  —  if  bypass(token   assignment) 

return  (TRUE); 
else  , 

SYNTAX  ERROR("Parameter  specification"); 
end  if;  ~  if  name  statement 

else 

SYNTAX_ERROR("Parameter  specification"); 
end  if;  —  if  mode  statement 

else 

SYNTAX_ERROR("Parameter  specification"); 
end  if;  —  if  bypass(token   colon) 

else 

return  (FALSE); 
end  if;  —  if  identifier   list  statement 

end  PARAMETER   SPECIFICATION; 


-  IDENTIFIER  LIST  ->    identifier  [,  identifier]* 
function  IDENTIFIERLIST  return  boolean  is 
begin 

put(RESULT  FILE,  "IN  IDENTIFIER  LIST");  NEW  LINE(RESULT  FILE); 
if  (BYPASS(TOKEN  IDENTIFIER))  then  i 

if  FORMAL   PARAM  DECLARE  AND  PACKAGE  BODY  DECLARE  then  ' 

WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  PARAM  TYPE,  NONE,  LAST  RECORE 
elsif  (NOT  PACKAGE  BODY   DECLARE)    then 
WRITE  HENRY_DATA(LOCAL   DECLARE,  DUMMYLEXEME,  IDENTTYPE, 
NONE,  LASTRECORD); 
end  if; 

while  (BYPASS(TOKEN_COMMA))  loop 
if  (IDENT  DECLARE)  OR  (FORMAL  PARAM  DECLARE  AND  PACKAGEBODY  DECLARE 
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then 

HENRY   WRITE  ENABLE  :=  TRUE; 
end  if; 

if  FORMAL   PARAM  DECLARE  AND  PACKAGE  BODY  DECLARE  then 
WRITE  HENRY  DATA(BLANK,  DUMMY   LEXEME,  PARAM  TYPE, 
NONE,  NEXT  HEN); 
elsif  (NOT  FORMAL   PARAM  DECLARE)  then 
WRITE  HENRY  DATA(LOCAL   DECLARE,  DUMMY  LEXEME,  IDENT  TYPE, 
NONE,  NEXT   HEN); 
end  if; 
if  not  (BYPASS(TOKEN_IDENTIFIER))  then 

SYNTAXERRORC'Identifier  list"); 
end  if;  —  if  not  bypass(token   identifer)  statement 

end  loop; 
return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  bypass(token   identifier)  statement 

end  IDENTIFIER   LIST; 


--  MODE-->    |in  ?] 

—  >    in  out 

—  >    out 

function  MODE  return  boolean  is 
begin 

put(RESULT  FILE,  "IN  PARAMETER  MODE");  NEW_LINE(RESULT_FILE); 
if  (BYPASS(TOKEN_IN))  then 

if  PACKAGE  BODY  DECLARE  THEN 

WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  PARAM  TYPE,  IN  TYPE,  LASTRECORD) 
end  if; 

if  (BYPASS(TOKEN   OUT))  then 
if  PACKAGE  BODY  DECLARE  then 
WRITE  HENRY  DATA(BLANK,  DUMMY   LEXEME,  PARAM  TYPE, 

INOUTTYPE,  LASTRECORD); 
end  if; 
end  if; 
elsif  (BYPASS(TOKEN  OUT))  then 
if  PACKAGE  BODY  DECLARE  then 

WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  PARAM  TYPE,  OUT  TYPE,  LAST  RECORE 
end  if; 
end  if; 

if  (LAST  RECORD. TYPE  DEFINE  =  PARAM  TYPE) 
AND  (LAST  RECORD. PARAM  TYPE   =  NONE)  THEN 

WRITE  HENRY_DATA(BLANK,  DUMMY  LEXEME,  PARAM  TYPE,  IN  TYPE,  LAST  RECORD) 
end  if; 

return  (TRUE); 
end  MODE; 
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-  DESIGNATOR  -->    identifier 
~>    string   literal 
function  DESIGNATOR  return  boolean  is 
begin 
if  (BVPASS(TOKEN  IDENTIFIER))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_STRING_LITERAL))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  DESIGNATOR; 


--  SIMPLE  STATEMENT  -->    null  ; 

-->    ASSIGNMENT  OR   PROCEDURE  CALL 
->    exit  EXIT  STATEMENT 
-->   return  RETURN  STATEMENT 
-->    goto  GOTO   STATEMENT 
-->    delay  DELAY  STATEMENT 
->    abort  ABORT  STATEMENT 
-->    raise  RAISE  STATEMENT 
function  SIMPLESTATEMENT  return  boolean  is 
begin 
if  (BYPASS(TOKEN_NULL))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Simple  statement"); 
end  if; 
elsif  (ASSIGNMENT  OR   PROCEDURECALL)  then  --  includes  a  check  for  a 
return  (TRUE);  —     code  statement  and  an 

~     entry  call  statement, 
elsif  (BYPASS(TOKEN_EXIT))  then 
if  (EXIT  STATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Simple  statement"); 
end  if; 
elsif  (BYPASS(TOKEN   RETURN))  then 
if  (RETURNSTATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Simple  statement"); 
end  if; 
elsif  (BYPASS(TOKEN   GOTO))  then 
if  (GOTOSTATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Simple  statement"); 
end  if; 
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elsif  (BYPASS(TOKEN_DELAY))  then 
if  (DELAY  STATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Simple  statement"); 
end  if; 
elsif  (BYPASS  (TOKENABORT))  then 
if  (ABORTSTATEMENT)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Simple  statement"); 
end  if; 
elsif  (BYPASS(TOKEN_RAISE))  then 
if  (RAISESTATEMENT)  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Simple  statement"); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  SIMPLE  STATEMENT; 


--  ASSIGNMENT  ORPROCEDURE  CALL  -->    NAME  :-  EXPRESSION  ; 

-->    NAME  ; 
function  ASSIGNMENT   OR   PROCEDURECALL  return  boolean  is 

ASSIGNPOINTER,  FUNCALL   POINTER  :  POINTER; 

begin 

put(result   file,  "in  assign  or  procedure  call");  new   line(result   file); 
HENRY~WRITE  ENABLE  :=  TRUE; 
ASSIGN  POINTER  :=  NEXT  HEN; 
if  (NAME)  then 
if  (BYPASS(TOKEN_ASSIGNMENT))  then 
ASSIGN  STATEMENT  :=  TRUE; 
WRITE  HENRY_DATA(BLANK,  DUMMY  LEXEME,  ASSIGN  TYPE, 

NONE,  NEXT  HEN); 
CREATE  NODE(NEXT  HEN,  LAST  RECORD); 
if  NAME  TAILSET  then 

WRITE  HENRY  DATA(BLANK,  DUMMYLEXEME,  PROCALL   OR  DS, 
NONE,  ASSIGN   POINTER); 
end  if; 

FUNCALL   POINTER  :=  NEXT   HEN; 
HENRY   WRITE  ENABLE  :=  TRUE; 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN  SEMICOLON))  then 
NAME  TAIL  SET  :=  FALSE; 
ASSIGNSTATEMENT  :=  FALSE; 
WRITE  HENRY_DATA(BLANK,  DUMMY  LEXEME,  END   ASSIGN  TYPE, 
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NONE,  NEXT  HEN); 
CREATE  NODE(NEXT  HEN,  LAST  RECORD); 
HENRY   WRITE  ENABLE  :=  FALSE; 

return  (TRUE);  —  parsed  an  assignment  statement 

else 

SYNTAX_ERROR{"Assignment  or  procedure  call"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Assignment  or  procedure  call"); 
end  if;  —  if  expression  statement 

elsif  (BYPASS(TOKEN_SEMICOLON))  then 
WRITE  HENRY_DATA(BLANK,  DUMMY  LEXEME,  PROCALLORDS, 

NONE,  ASSIGN  POINTER); 
CREATE  NODE(NEXT  HEN,  LASTRECORD); 

return  (TRUE);  —  parsed  a  procedure  call  statement 

else 

SYNTAX   ERROR("Assignment  or  procedure  call"); 
end  if;  —  if  bypass(token   assignment) 

else 

return  (FALSE); 
end  if;  —  if  name  statement 

end  ASSIGNMENT  OR  PROCEDURE  CALL; 


--  LABEL  -->    <<  identifier  >> 
function  LABEL  return  boolean  is 
begin 
if  (BYPASS(TOKEN_LEFT  BRACKET))  then 
if  (BYPASS(TOKEN_IDENTIFIER))  then 
if  (BYPASS(TOKEN_RIGHT  BRACKET))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Label"); 
end  if;  —  if  bypass(token   right   bracket) 

else 

SYNTAX_ERROR("Label"); 
end  if;  --  if  bypasss(token   identifier) 

else 

return  (FALSE); 
end  if;  ~  if  bypass(token   left   bracket) 

end  LABEL; 


--  ENTRYDECLARATION  ->   entry  identifier   (DISCRETERANGE)  ?] 

(FORMAL  PART  ?|  ; 
function  ENTRYDECLARATION  return  boolean  is 
begin 
if  (BYPASS(TOKEN   ENTRY))  then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
if  (BYPASS(TOKEN_LEFT_PAREN))  then 
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if  (DISCRETE  RANGE)  then 
if  (BYPASS(TOKEN   RIGHT   PAREN))  then 

null; 
else 

SYNTAX_ERROR("Entry  declaration"); 
end  if;  —  if  bypass(token   right   paren) 

else 

SYNTAX_ERROR("Entry  declaration"); 
end  if;  —  if  discrete   range  statement 

end  if;  —  if  bypass(tokenleft   paren) 

if  (FORMALPART)  then 

null; 
end  if;  —  if  formal   part  statement 

if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Entry  declaration"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Entry  declaration"); 
end  if;  —  if  bypass(tokenidentifier) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   entry) 

end  ENTRY  DECLARATION; 


-  REPRESENTATION  CLAUSE  -->    for  NAME  use  record  RECORD   REPRESENTATIONCLAUSE 

-->    for  NAME  use  |at  -^j  SIMPLE  EXPRESSION; 
function  REPRESENTATION   CLAUSE  return  boolean  is 
begin 
if  (BYPASS(TOKEN_FOR))  then 
if  (NAME)  then 
if  (BYPASS(TOKEN_USE))  then 
if  (BYPASS(TOKEN_RECORD  STRUCTURE))  then 
if  (RECORDREPRESENTATIONCLAUSE)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Representation  clause"); 
end  if;  —  if  record   representation   clause 

elsif  (BYPASS(TOKEN_AT))  then 
if  (SIMPLEEXPRESSION)  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Representation  clause"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Representation  clause"); 
end  if;  —  if  simple   expression  statement 

elsif  (SIMPLEEXPRESSION)  then 
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if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX   ERROR("Representation  clause"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Representation  clause"); 
end  if;  ~  if  bypass(token   record) 

else 

SYNTAX  ERROR("Representation  clause"); 
end  if;  —  if  bypass(token   use) 

else 

SYNTAX  ERROR("Representation  clause"); 
end  if;  ~  if  name  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   for) 

end  REPRESENTATION  CLAUSE; 


--  RECORDREPRESENTATION  CLAUSE  -->    [at  mod  SIMPLE  EXPRESSION  ?] 

[NAME  at  SIMPLE  EXPRESSION  range  RANGES)* 
end  record  ; 
function  RECORD  REPRESENT  ATIONCLAUSE  return  boolean  is 
begin 
if  (BYPASS(TOKEN_AT))  then 
if  (BYPASS(TOKEN_MOD))  then 
if  (SIMPLEEXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Record  representation  clause"); 
end  if;  —  if  simple   expression 

else 

SYNTAX_ERROR("Record  representation  clause"); 
end  if;  —  if  bypass(token   mod) 

end  if;  —  if  bypass(token   at) 

while  (NAME)  loop 
if  (BYPASS(TOKEN_AT))  then 
if  (SIMPLE  EXPRESSION)  then 
if  (BYPASS(TOKEN  RANGE))  then 
if  (RANGES)  then 

null; 
else 

SYNTAX_ERROR("Record  representation  clause"); 
end  if;  —  if  ranges  statement 

else 

SYNTAX_ERROR("Record  representation  clause"): 
end  if;  —  if  bypass(token   range) 

else 

SYNTAX_ERROR("Record  representation  clause"); 
end  if;  —  if  simple   expression 
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else 

SYNTAX   ERROR("Record  representation  clause"): 
end  if;  —  if  bypass(token   at) 

end  loop; 

if  (BYPASS(TOKEN_END))  then 
if  (BYPASS(TOKEN_RECORD_STRUCTURE))  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Record  representation  clause"); 
end  if;  —  if  bypass(token   semicolon) 

else 

SYNTAX_ERROR("Record  representation  clause"); 
end  if;  —  if  bypass(token   record   structure) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   end) 

end  RECORDREPRESENTATIONCLAUSE; 

end  PARSER   2; 


-  TITLE:  AN  ADA  SOFTWARE  METRIC 

-  MODULE  NAME:      PACKAGE  PARSER  3 

-  DATE  CREATED:     22  JUL  86 
--    LAST  MODIFIED:    30  MAY  87 

--   AUTHORS:  LCDR  JEFFREY  L.  NIEDER 

LT  KARL  S.  FAIRBANKS,  JR. 
LCDR  PAUL  M.  HERZIG 

-  DESCRIPTION:    This  package  contains  thirty-five  functions 

that  make  up  the  baseline  productions  for  our  top-down, 
recursive  descent  parser.    Each  function  is  preceded 
by  the  grammar  productions  they  are  implementing. 

with  PARSER  4,  HENRY  GLOBAL,  HENRY,  BYPASS  FUNCTION,  HALSTEAD  METRIC, 

GLOBAL  PARSER,  GLOBAL,  TEXT  lO; 
use  PARSER  4,  HENRY  GLOBAL,  HENRY,  BYPASS  FUNCTION,  HALSTEAD  METRIC, 
GLOBAL  PARSER,  GLOBAL,  TEXTIO; 

package  PARSER   3  is 
function  SUBTYPEINDICATION  return  boolean; 
function  ARRAY  TYPE  DEFINITION  return  boolean; 
function  CHOICE  return  boolean; 
function  ITERATIONSCHEME  return  boolean; 
function  LOOPPARAMETERSPECIFICATION  return  boolean; 
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function  EXPRESSION  return  boolean; 
function  RELATION  return  boolean; 
function  RELATION   TAIL  return  boolean; 
function  SIMPLE   EXPRESSION  return  boolean; 
function  SIMPLEEXPRESSION  TAIL  return  boolean; 
function  TERM  return  boolean; 
function  FACTOR  return  boolean; 
function  PRIMARY  return  boolean; 
function  CONSTRAINT  return  boolean; 

function  FLOATING   OR   FIXED   POINT  CONSTRAINT  return  boolean; 
function  INDEX   CONSTRAINT  return  boolean; 
function  RANGES  return  boolean; 
function  AGGREGATE  return  boolean; 
function  COMPONENT   ASSOCIATION  return  boolean; 
function  ALLOCATOR  return  boolean; 
function  NAME  return  boolean; 
function  NAME  TAIL  return  boolean; 
function  LEFT   PARENNAMETAIL  return  boolean; 
function  ATTRIBUTEDESIGNATOR  return  boolean; 
function  INTEGER  TYPE   DEFINITION  return  boolean; 
function  DISCRETE   RANGE  return  boolean; 
function  EXIT   STATEMENT  return  boolean; 
function  RETITIN    STATEMENT  return  boolean; 
function  GOTO   STATEMENT  return  boolean; 
function  DELAYSTATEMENT  return  boolean; 
function  ABORT  STATEMENT  return  boolean; 
function  RAISE  STATEMENT  return  boolean; 
end  PARSER   3;  ~ 


package  body  PARSER  3  is 

--  SI  BTYPE  INDICATION  -->    NAME  [CONSTRAINT  ?] 
function  SUBTYPE  INDICATION  return  boolean  is 
begin 
if  (NAME)  then  —  check  for  type   mark 

if  (CONSTRAINT)  then 

null; 
end  if; 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  SUBTYPE  INDICATION; 


--  ARRAY  TYPE  DEFINITION  ->    (INDEX  CONSTRAINT  of  SUBTYPE  INDICATION 

—  this  function  parses  both  constrained  and  unconstrained  arrays 
function  ARRAYTYPE  DEFINITION  return  boolean  is 
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begin 
if  (BYPASS(TOKEN_LEFT_PAREN))  then 
if  (INDEXCONSTRAINT)  then 
if  (BYPASS(TOKEN   OF))  then 
if  (SLBTYPEINDICATION)  then 

return  (TRUE); 
else 

SYNTAX   ERROR(" Array  definition"); 
end  if;  —  if  subtype   indication 

else 

SYNTAX_ERROR(" Array  definition"); 
end  if;  —  if  bypass(token   of) 

else 

SYNTAX   ERROR(" Array  definition"); 
end  if;  —  if  index   constraint  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   left   paren) 

end  ARRAY  TYPE  DEFINITION; 


--  CHOICE  -->    EXPRESSION  [..SIMPLE  EXPRESSION  ?] 
-->    EXPRESSION  [CONSTRAINT  ?) 
— >    others 
function  CHOICE  return  boolean  is 
begin 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN   RANGEDOTS))  then  -  check  for  discrete   range 
if  (SIMPLEEXPRESSION)  then 

null; 
else 

SYNTAX  ERROR("Choice"); 
end  if;  ~  if  simpleexpression  statement 

elsif  (CONSTRAINT)  then 

null; 
end  if;  —  if  bypass  token   range   dots 

return  (TRUE); 
elsif  (BYPASS(TOKEN_OTHERS))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  CHOICE; 


--  ITERATION  SCHEME -->   while  EXPRESSION 

->    forLOOP  PARAMETER  SPECIFICATION 
function  ITERATIONSCHEME  return  boolean  is 
begin 

if  (BYPASS(TOKEN_WHILE))  then 
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NESTING   METRIC ( WHILE  CONSTRUCT) ; 
if  (EXPRESSION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Iteration  scheme"); 
end  if; 
elsif  (BYPASS(TOKEN  FOR))  then 
NESTING   METRIC(FOR  CONSTRUCT); 
if  (LOOP  PARAMETERSPECIFICATION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Iteration  scheme"); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  ITERATION   SCHEME; 


--  LOOP  PARAMETER   SPECIFICATION  -->    identifier  in    reverse  ?]  DISCRETERANGE 
function  LOOPPARAMETER   SPECIFICATION  return  boolean  is 
begin 
if  (BYPASS(TOKEN_IDENTIFIER))  then 
if  (BYPASS(TOKEN_IN))  then 
if  (BYPASS(TOKEN  REVERSE))  then 

null; 
end  if;  —  if  bypass(token  reverse) 

if  (DISCRETERANGE)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Loop  parameter  specification"); 
end  if;  —  if  discrete   range  statement 

else 

SYNTAX_ERROR("Loop  parameter  specification"); 
end  if;  ~  if  bypass(token   in) 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   identifier) 

end  LOOP  PARAMETER  SPECIFICATI0N7 


--  EXPRESSION -->    RELATION  [RELATION  TAIL  ?] 
function  EXPRESSION  return  boolean  is 
begin 
if  (RELATION)  then 
if  (RELATIONTAIL)  then 

null; 
end  if;  —  if  relation   tail  statement 

return  (TRUE); 
else 


162 


return  (FALSE); 
end  if;  —  if  relation  statement 

end  EXPRESSION; 


--  RELATION  -->    SIMPLE  EXPRESSION  ISIMPLE  EXPRESSION  TAIL  ?] 
function  RELATION  return  boolean  is 
begin 
if  (SIMPLE  EXPRESSION)  then 
if  (SIMPLE  EXPRESSION  TAIL)  then 

null; 
end  if;  --  if  simpleexpression   tail  statement 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  simpleexpression  statement 

end  RELATION; 


-  RELATION  TAIL  -->    [and  (then  ?|  RELATION]* 
-->    [or  lelse  ?]  RELATION]* 
-->    Jxor  RELATION]* 
function  RELATION  TAIL  return  boolean  is 
begin 
while  (BYPASS(TOKEN_AND))  loop 
if  (BYPASS(TOKEN_THEN))  then 

null; 
end  if;  ~  if  bypass(token   then) 

if  not  (RELATION)  then 

SYNTAX_ERROR("Relation  tail"); 
end  if;  —  if  not  relation  statement 

end  loop; 

while  (BYPASS(TOKEN  OR))  loop 
if  (BYPASS(TOKEN_ELSE))  then 

null; 
end  if;  --  if  bypass(token   else) 

if  not  (RELATION)  then 

SYNTAX_ERROR("Relation  tail"); 
end  if;  ~  if  not  relation  statement 

end  loop; 

while  (BYPASS(TOKEN_XOR))  loop 
if  not  (RELATION)  then 

SYNTAX_ERROR("Relation  tail"); 
end  if;  —  if  not  relation  statement 

end  loop; 
return  (TRUE); 
end  RELATION  TAIL; 
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-  SIMPLE  EXPRESSION  -->    [+  ?1  TERM  |BINARY   ADDING   OPERATOR   TERM]* 
->    I-  ?]  TERM  IBINARY  ADDING   OPERATOR   TERM)* 
function  SIMPLE  EXPRESSION  return  boolean  is 
begin 
if  (BYPASS(TOKEN  PLUS)  or  BYPASS(TOKEN  MINUS))  then 
if  (TERM)  then 
while  (BINARY   ADDING   OPERATOR)  loop 
if  not  (TERM)  then 

SYNTAX_ERROR("Simple  expression"); 
end  if;  —  if  not  term  statement 

end  loop; 
return  (TRUE); 
else 

SYNTAXERRORC'Simple  expression"); 
end  if;  —  if  term  statement 

elsif  (TERM)  then 
while  (BINARY   ADDINGOPERATOR)  loop 
if  not  (TERM)  then 

SYNTAX   ERROR("Simple  expression"); 
end  if;  —  if  not  term  statement 

end  loop; 
return  (TRUE); 
else 

return  (FALSE); 
end  if;  ~  if  bypass(token    plus)  et  al  statement 

end  SIMPLE  EXPRESSION; 


--  SIMPLEEXPRESSION  TAIL  -->    RELATIONAL  OPERATOR   SIMPLEEXPRESSION 

-->    [not  ?]  in  RANGES 
-->    [not  ?|  in  NAME 
function  SIMPLEEXPRESSIONTAIL  return  boolean  is 
begin 
if  (RELATIONAL   OPERATOR)  then 
if  (SIMPLE   EXPRESSION)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Simple  expression  tail"); 
end  if;  —  if  simpleexpression  statement 

elsif  (BYPASS(TOKEN_NOT))  then 
if  (BYPASS(TOKEN_IN))  then 
if  (RANGES)  then 

return  (TRUE); 
elsif  (NAME)  then  --  check  for  typemark 

return  (TRUE); 
else 

SYNTAX_ERROR("Simple  expression  tail"); 
end  if;  —  if  ranges  statement 

else 

SYNTAX_ERROR("Simple  expression  tail"); 
end  if;  --  if  bypass  (token   in)  statement 
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elsif  (BYPASS(TOKENJN))  then 
if  (RANGES)  then 

return  (TRUE); 
elsif  (NAME)  then  ~  check  for  type   mark 

return  (TRUE); 
else 

SYNTAX  ERROR("Simple  expression  tail"); 
end  if;  —  if  ranges  statement 

else 

return  (FALSE); 
end  if;  ~  if  relational  operator  statement 

end  SIMPLE  EXPRESSION  TAIL; 


--TERM-->    FACTOR  [MULTIPLYING   OPERATOR   FACTOR]* 
function  TERM  return  boolean  is 
begin 
if  (FACTOR)  then 
while  (MULTIPLYINGOPERATOR)  loop 
if  not  (FACTOR)  then 

SYNTAX_ERROR("Term"); 
end  if;  —  if  not  factor  statement 

end  loop; 
return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  factor  statement 

end  TERM; 


-  FACTOR  -->    PRIMARY  j**  PRIMARY  ?| 
-->    abs  PRIMARY 
->    not  PRIMARY 
function  FACTOR  return  boolean  is 
begin 
if  (PRIMARY)  then 
if  (BYPASS(TOKEN  EXPONENT))  then 
if  (PRIMARY)  then 

null; 
else 

SYNTAX_ERROR("Factor"); 
end  if;  ~  if  primary  statement 

end  if;  ~  if  bypass(token   exponent)  statement 

return  (TRUE); 
elsif  (BYPASS(TOKEN_ABSOLUTE))  then 
if  (PRIMARY)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Factor"); 
end  if;  —  if  primary(abs)  statement 
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elsif  (BYPASS(TOKEN_NOT))  then 
if  (PRIMARY)  then 

return  (TRUE); 
else 

SYNTAX   ERRORC'Factor"); 
end  if;  —  if  primary  (not)  statement 

else 

return  (FALSE); 
end  if;  —  if  primary  statement 

end  FACTOR; 


-- PRIMARY -->    numeric  literal 

—  >    null 

—  >    string   literal 

-->    new  ALLOCATOR 
-->    NAME 
-->    AGGREGATE 
function  PRIMARY  return  boolean  is 
begin 
HENRY   WRITE  ENABLE  :=  TRUE; 
if  (BYPASS(TOKEN  NUMERIC  LITERAL))  then 
WRITE  HENRY   DATA(BLANK,  DUMMYLEXEME,  IDENTTYPE,  NONE,  LASTRECORD) 
return  (TRUE); 
elsif  (BYPASS(TOKEN_NULL))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN  STRING   LITERAL))  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  IDENT  TYPE,  NONE,  LAST  RECORD] 
return  (TRUE); 
elsif  (BYPASS(TOKEN_NEW))  then 
if  (ALLOCATOR)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Primary"); 
end  if;  --  if  allocator  statement 

elsif  (NAME)  then 

return  (TRUE); 
elsif  (AGGREGATE)  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  bypass(token   left   paren) 

end  PRIMARY; 


--  CONSTRAINT  -->    range  RANGES 
—  >    range  <> 

-->  digits  FLOATING  OR  FIXED  POINT  CONSTRAINT 
->  delta  FLOATING  ORFIXEDPOINTCONSTRAINT 
-->    (INDEX  CONSTRAINT 
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function  CONSTRAINT  return  boolean  is 
begin 
if  (BYPASS(TOKEN  RANGE))  then 
if  (RANGES)  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_BRACKETS))  then  --  check  for  <>  when  parsing 

return  (TRUE);  —     an  unconstrained  array 

else 

SYNTAXERRORC'Constraint"); 
end  if;  —  if  ranges  statennent 

elsif  (BYPASS(TOKEN   DIGITS))  or  else  (BYPASS(TOKEN_DELTA))  then 
if  (FLOATINGORFIXED   POINTCONSTRAINT)  then 

return  (TRUE); 
else 

SYNTAXERRORC'Constraint"); 
end  if; 
elsif  (BYPASS(TOKEN  LEFTPAREN))  then 
if  (INDEXCONSTRAINT)  then 

return  (TRUE); 
else 

SYNTAXERRORC'Constraint"); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  CONSTRAINT; 


--  FLOATING   OR   FIXED  POINT  CONSTRAINT  -->    SIMPLE  EXPRESSION   range  RANGES  ?] 
function  FLOATING   OR   FIXED   POINTCONSTRAINT  return  boolean  is 
begin 
if  (SIMPLE  EXPRESSION)  then 
if  (BYPASS(TOKEN_RANGE))  then 
if  (RANGES)  then 

null; 
else 

SYNTAX_ERROR("Floating  or  fixed  point  constraint"); 
end  if;  ~  if  ranges  statement 

end  if;  --  if  bypass(token   range) 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  simple  expression  statement 

end  FLOATING   OR  FIXED  POINT  CONSTRAINT; 


--  INDEX  CONSTRAINT  -->    DISCRETE  RANGE  |,  DISCRETERANGEj*  ) 
function  INDEX  CONSTRAINT  return  boolean  is 
begin 

if  (DISCRETE  RANGE)  then 
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while  (BYPASS(TOKEN_COMMA))  loop 
if  not  (DISCRETERANGE)  then 

SYNTAX_ERROR("Index  constraint"); 
end  if;  —  if  not  discrete   range 

end  loop; 
if  (BYPASS(TOKEN_RIGHT_PAREN))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Index  constraint"); 
end  if;  --  if  bypass(tokenright   paren) 

else 

return  (FALSE); 
end  if;  —  if  discrete   range  statement 

end  INDEX   CONSTRAINT; 


--  RANGES  ->    SIMPLE  EXPRESSION  [..SIMPLEEXPRESSION  ?j 
function  RANGES  return  boolean  is 
begin 
if  (SIMPLEEXPRESSION)  then 
if  (BYPASS(TOKEN_RANGE_DOTS))  then 
if  (SIMPLE   EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Ranges"); 
end  if;  ~  if  simple   expression  statement 

end  if;  —  if  bypass(tokenrangedots) 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  simpleexpression  statement 

end  RANGES; 


--  AGGREGATE -->    (COMPONENT   ASSOCIATION  [,  COMPONENT  ASSOCIATION]*  ) 
function  AGGREGATE  return  boolean  is 
begin 
if  (BYPASS(TOKEN_LEFT  PAREN))  then 
if  (COMPONENTASSOCIATION)  then 
while  (BYPASS(TOKEN_COMMA))  loop 
if  not  (COMPONENTASSOCIATION)  then 

SYNTAX_ERROR("Aggregate"); 
end  if;  —  if  not  component  association 

end  loop; 
if  (BYPASS(TOKEN_RIGHT  PAREN))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("  Aggregate"); 
end  if;  —  if  bypass(token_right_paren) 

else 
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SYNTAX_ERROR("  Aggregate"); 
end  if;  —  if  component   association  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token   left   paren) 

end  AGGREGATE; 


-  COMPONENT  ASSOCIATION  -->    |CHOICE  |   CHOICE]*  =>  ?]  EXPRESSION 
function  COMPONENTASSOCIATION  return  boolean  is 
begin 
if  (CHOICE)  then 
while  (BYPASS(TOKEN_BAR))  loop 
if  not  (CHOICE)  then 

SYNTAX_ERROR("Component  asociation"); 
end  if; 
end  loop; 

if  (BYPASS(TOKEN_ARROW))  then 
if  (EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Component  asociation"); 
end  if;  —  if  expression  statement 

end  if;  —  if  bypass(token   arrow) 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  --  if  choice  statement 

end  COMPONENT   ASSOCIATION; 


--  ALLOCATOR  -->    SUBTYPE  INDICATION  ['AGGREGATE  ?| 
function  ALLOCATOR  return  boolean  is 
begin 
if  (SUBTYPEINDICATION)  then 
if  (BYPASS(TOKEN   APOSTROPHE))  then 
if  (AGGREGATE)  then 

null; 
else 

SYNTAX_ERROR("  Allocator"); 
end  if;  —  if  aggregate  statement 

end  if;  —  if  bypass(token   apostrophe) 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  —if  subtype   indication  statement 

end  ALLOCATOR; 
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-  NAME  -->    identifier  [NAMETAIL  ?] 

-->    character   literal  [NAMETAIL  ?] 
->    stnngliteral  1NAME_TAIL  ?] 
function  NAME  return  boolean  is 


begin 

pul(result   file,  "in  name");  new   line(result   file); 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
NAME  POINTER  :=  LAST   RECORD; 
if  (NAMETAIL)  then 

null; 
end  if; 

return  (TRUE); 
HENRY   WRITE  ENABLE  :=  TRUE; 
elsif  (BYPASS(TOKEN_CHARACTER_LITERAL))  then 
if  (NAMETAIL)  then 

null; 
end  if; 

return  (TRUE); 
elsif  (BYPASS(TOKEN_STRING_LITERAL))  then 
if  (NAME_TAIL)  then 

null; 
end  if; 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  NAME; 


-  NAMETAIL  -->    (LEFT  PARENNAMETAIL 
-->     SELECTOR  [NAME  TAIL]* 
-->     AGGREGATE  [NAME  TAIL!* 
-->     ATTRIBUTE  DESIGNATOR  [NAMETAIL]* 
function  NAME  TAIL  return  boolean  is 
begin 

put(result   file,  "in  name  tail");  new   line(result   file); 
if  (BYPASS(TOKEN_LEFT_PAREN))  then  ~ 
NAME  TAIL   SET  :-  TRUE; 
HENRY   WRITE  ENABLE  :=  TRUE; 
if  ASSIGN  STATEMENT  then 
WRITE  HENRY   DATA(BLANK,  DUMMYLEXEME,  FUNCALL  OR   DS, 

NONE,  NAME  POINTER); 
else  WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  PROCALL   ORDS, 

NONE,  NAMEPOINTER); 
end  if; 
if  (LEFT  PARENNAME  TAIL)  then 

return  (TRUE); 
else 
return  (FALSE); 
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end  if;  —  if  left   paren    name   tail 

elsif(BYPASS(TOKEN  PERIOD))  then 
if  (SELECTOR)  then 
while  (NAMETAIL)  loop 

null; 
end  loop; 
return  (TRUE); 
else 

SYNTAX   ERROR("Name  tail"); 
end  if;  —  if  selector  statement 

elsif  (BYPASS(TOKEN   APOSTROPHE))  then 
if  (AGGREGATE)  then 
while  (NAMETAIL)  loop 

null; 
end  loop; 
return  (TRUE); 
elsif  (ATTRIBUTEDESIGNATOR)  then 
while  (NAMETAIL)  loop 

null; 
end  loop; 
return  (TRUE); 
else 

SYNTAX   ERRORC'Name  tail"); 
end  if;  —  if  aggregate  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token    left   paren) 

end  NAME  TAIL; 


--  LEFT  PAREN  NAME  TAIL  -->    [FORMAL   PARAMETER  ?]  EXPRESSION   ..EXPRESSION  "^1 

(,  [FORMALPARAMETER  ?]  EXPRESSION  [..EXPRESSION  ?]J* 
)  [NAME  TAIL]* 
function  LEFT   PAREN   NAMETAIL  return  boolean  is 
begm 

put(result   file,  "in  left  paren  name  tail");  new   line(result    file); 
if  (FORMAL   PARAMETER)  then  --  check  for  optional  formal  parameter 

null;  —     before  the  actual  parameter 

end  if;  —  if  formal   parameter  statement 

HENRY   WRITE  ENABLE  :=  TRUE; 
if  (EXPRESSION)  then 
if  NAME  TAIL  SET  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  PARAM  TYPE,  ACTUAL  PARAM, 

LAST  RECORD); 
end  if; 

if  (BYPASS(TOKEN  RANGE  DOTS))  then 
if  not  (EXPRESSION)  then 

SYNTAX_ERROR("Left  paren  name  tail"); 
end  if;  —  if  not  expression  statement 

end  if;  —  if  bypass(token   range  dots) 

while  (BYPASS(TOKEN_COMMA))  loop 
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if  (FORMALPARAMETER)  then 

null; 
end  if;  ~  if  formalparameter  statement 

HENRY   WRITE  ENABLE  :=  TRUE; 
if  not  (EXPRESSION)  then 

SYNTAX   ERROR("Left  paren  name  tail"); 
end  if;  —  if  not  expression  statement 

if  (BYPASS(TOKEN  RANGE  DOTS))  then 
if  not  (EXPRESSION)  then 

SYNTAX_ERROR("Left  paren  name  tail"); 
end  if;  ~  if  not  expression  statement 

end  if;  —  if  bypass(token   range   dots) 

if  NAMETAILSET  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  PARAM  TYPE,  ACTUAL  PARAM, 

LASTRECORD); 
end  if; 
end  loop; 

if  (BYPASS(TOKEN  RIGHT  PAREN))  then 
WRITE  HENRY  DATA(BLANK,  DUMMY  LEXEME,  ENDACTUALPARAM, 

ACTUAL   PARAM,  NEXT  HEN); 
CREATE  NODE(NEXT  HEN,  LASTRECORD); 
NAME  TAIL   SET  :-  FALSE; 
while  (NAMETAIL)  loop 

null; 
end  loop; 
return  (TRUE); 
else 

return  (FALSE); 
end  if:  ~  if  bypass(token   right   paren) 

elsif  (DISCRETERANGE)  then 

if  (BYPASS(TOKEN  RIGHT   PAREN))  then 
while  (NAME  TAIL)  LOOP 

NULL; 
END  LOOP; 
RETURN  (TRUE); 
else 

SYNTAX_ERROR("Left  paren  name  tail"); 
end  if; 
else 

return  (FALSE); 
end  if;  —  if  bypass(token   right   paren) 

end  LEFT  PAREN  NAME  TAIL; 


--  ATTRIBUTEDESIGNATOR  -->    identiher  [(EXPRESSION)  ?] 

->    range  [(EXPRESSION)  ''I 
-->    digits  [(EXPRESSION)  ?| 
->    delta  [(EXPRESSION)  ?] 
function  ATTRIBUTEDESIGNATOR  return  boolean  is 
begin 
if  (BYPASS(TOKEN  IDENTIFIER))  or  else  (BYPASS(TOKEN  RANGE))  then 
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if  (BYPASS(TOKEN_LEFT_PAREN))  then 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN_RIGHT_PAREN))  then 

null; 
else 

SYNTAX_ERROR(" Attribute  designator"); 
end  if;  —  if  bypass(token   right   paren)  statement 

else 

SYNTAX_ERROR{"Attribute  designator"); 
end  if;  —  if  expression  statement 

end  if;  ~  if  bypass(token   left   paren)  statement 

return  (TRUE); 
elsif  (BYPASS(TOKEN_DIGITS))  or  else  (BYPASS(TOKEN_DELTA))  then 
if  (BYPASS(TOKEN_LEFT_PAREN))  then 
if  (EXPRESSION)  then 
if  (BYPASS(TOKEN  RIGHT  PAREN))  then 

null; 
else 

SYNTAX_ERROR(" Attribute  designator"); 
end  if;  --  if  bypass(token   right   paren)  statement 

else 

SYNTAX_ERROR(" Attribute  designator"); 
end  if;  —  if  expression  statement 

end  if;  —  if  bypass(token   left    paren)  statement 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  bypass(token   identifier)  statement 

end  ATTRIBUTE  DESIGNATOR; 


-  INTEGER  TYPE  DEFINITION  -->    range  RANGES 
function  INTEGERTYPEDEFINITION  return  boolean  is 
begin 
if  (BYPASS(TOKEN_RANGE))  then 
if  (RANGES)  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Integer  type  definition"); 
end  if; 
else 

return  (FALSE); 
end  if; 
end  INTEGER  TYPE  DEFINITION; 


--  DISCRETE  RANGE  ->    RANGES  [CONSTRAINT  ?) 
function  DISCRETERANGE  return  boolean  is 
begin 

if  (RANGES)  then 
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if  (CONSTRAINT)  then 

null; 
end  if;  —  if  constraint  statement 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  ranges  statement 

end  DISCRETE  RANGE; 


--  EXITSTATEMENT  -->    [NAME  ?)  [when  EXPRESSION  ?j  ; 
function  EXITSTATEMENT  return  boolean  is 
begin 
if  (NAME)  then 

null; 
end  if;  —  if  name  statement 

if  (BYPASS(TOKEN_WHEN))  then 
if  (EXPRESSION)  then 

null; 
else 

SYNTAX_ERROR("Exit  statement"); 
end  if;  —  if  expression  statement 

end  if;  —  if  bypass(token   when) 

if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if;  —  if  bypass(token   semicolon) 

end  EXIT   STATEMENT; 


--  RETURN  STATEMENT  -->    [EXPRESSION  ?| 
function  RETURN   STATEMENT  return  boolean  is 
begin 
if  (EXPRESSION)  then 

null; 
end  if; 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  RETURN  STATEMENT; 


--  GOTOSTATEMENT  ->    NAME  ; 
function  GOTO   STATEMENT  return  boolean  is 
begin 

if  (NAME)  then 
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if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Goto  statement"); 
end  if;  —  if  bypass(token   semicolon) 

else 

return  (FALSE); 
end  if;  ~  if  name  statement 

end  GOTO   STATEMENT; 


--  DELAY  STATEMENT  -->    SLMPLE  EXPRESSION  ; 
function  DELAYSTATEMENT  return  boolean  is 
begin 
if  (SIMPLE  EXPRESSION)  then 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAXERRORC'Delay  statement"); 
end  if;  ~  if  bypass(token   semicolon) 

else 

return  (FALSE); 
end  if;  —  if  simple   expression  statement 

end  DELAY   STATEMENT; 


--  ABORT  STATEMENT  -->    NAME  !,  NAME]*  ; 
function  ABORTSTATEMENT  return  boolean  is 
begin 
if  (NAME)  then 
while  (BYPASS(TOKEN_COMMA))  loop 
if  not  (NAME)  then 

SYNTAX_ERROR(" Abort  statement"); 
end  if;  —  if  not  name  statement 

end  loop; 
if  (BYPASS(TOKEN_SEMICOLON))  then 

return  (TRUE); 
else 

SYNTAX_ERROR(" Abort  statement"); 
end    if;  —  if  bypass(token   semicolon] 

else 

return  (FALSE); 
end  if;  —  if  name  statement 

end  ABORT   STATEMENT; 


--  RAISE  STATEMExNT  -->    [NAME  ?]  ; 
function  RAISESTATEMENT  return  boolean  is 
begin 
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if  (NAME)  then 

null; 
end  if; 
if  (BYPASS(TOKEN  SEMICOLON))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  RAISE  STATEMENT; 

end  PARSER   3; 


--   TITLE:  AN  ADA  SOFTWARE  METRIC 

--    MODULE  NAME:      PACKAGE  PARSERJ 
--    DATE  CREATED:     23  JUL  86 
--    LAST  MODIFIED:    30  MAY  87 

--    AUTHORS:  LCDR  JEFFREY  L.  NIEDER 

LT  KARL  S.  FAIRBANKS,  JR. 
LCDR  PAUL  M.  HERZIG 
--    DESCRIPTION:    This  package  contains  seven  functions  that 
are  the  lowest  level  productions  for  our  top-down, 
recursive  descent  parser.    Each  function  is  preceded 
by  the  grammar  productions  they  are  implementing. 

*************************************************************** 

with  BYPASSFUNCTION,  BYPASS  SUPPORT  FUNCTIONS.  GLOBAL  PARSER,  GLOBAL,  TEX 
use  BYPASS  FUNCTION,  BYPASSSUPPORT  FUNCTIONS,  GLOBALPARSER,  GLOBAL,  TEXl 

package  PARSER   4  is 

function  MULTIPLYING    OPERATOR  return  boolean; 

function  BINARY   ADDING   OPERATOR  return  boolean; 

function  RELATIONAL   OPERATOR  return  boolean; 

function  ENUMERATION  TYPE  DEFINITION  return  boolean; 

function  ENUMERATION   LITERAL  return  boolean; 

function  FORMALPARAMETER  return  boolean; 

function  SELECTOR  return  boolean; 
end  PARSER   4; 


package  body  PARSER   4  is 
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-  MULTIPLYING  OPERATOR  -->    * 

->    / 

—  >    mod 

—  >    rem 

function  MULTIPLYINGOPERATOR  return  boolean  is 
begin 

put(RESULT   FILE,  "In  multiplying   operator  ");  new_line(RESULT   FILE); 
if  (BYPASS(TOKEN_ASTERISK))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_SLASH))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN   MOD))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN  REM))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  MULTIPLYING   OPERATOR; 


--  BINARY   ADDING   OPERATOR  -->    + 

->    & 
function  BINARYADDING   OPERATOR  return  boolean  is 
begin 

put(RESULT_FILE,  "In  binary   addingoperator  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN   PLUS))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN  MINUS))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_AMPERSAND))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  BINARY  ADDING   OPERATOR; 


--    RELATIONAL   OPERATOR  ->    = 

->    /= 

~>    < 

->    <  = 

->    > 

~>    >  = 
function  RELATIONAL   OPERATOR  return  boolean  is 
begin 

put(RESULT_FILE,  "In  relationaloperator  ");  new   line(RESULT_FILE); 
if  (BYPASS(TOKEN_EQUALS))  then 
return  (TRUE); 
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elsif  (BYPASS(TOKEN  NOTEQUALS))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_LESS_THAN))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_LESS_THAN   EQUALS))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN  GREATERTHAN))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_GREATER_THAN_EQUALS))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  RELATIONAL   OPERATOR: 


--  ENUMERATION  TYPE  DEFLNITION  ->    (ENUMERATION  LITERAL 

[,  ENUMERATION  LITERAL]*) 
function  ENUMERATION  TYPE  DEFINITION  return  boolean  is 
begin 

put(RESULT_FILE,  "In  enumerationtypedefinition  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN  LEFTPAREN))  then 
HENRY   WRITE  ENABLE  :=  TRUE; 
if  (ENUMERATION  LITERAL)  then 
while  (BYPASS(TOKEN  COMMA))  loop 
HENRYWRITEENABLE  :=  TRUE; 
if  not  (ENUMERATION  LITERAL)  then 

SYNTAX   ERROR("Enumeration  type  definition"); 
end  if;  —  if  not  enumeration    literal 

end  loop; 
if  (BYPASS(TOKEN  RIGHT  PAREN))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Enumeration  type  definition"), 
end  if;  —  if  bypass(token    right   paren) 

else 

SYNTAX_ERROR("Enumeration  type  definition"); 
end  if;  —  if  enumeration   literal  statement 

else 

return  (FALSE); 
end  if;  —  if  bypass(token    left   paren) 

end  ENUMERATION  TYPE  DEFINITION; 


--  ENUMERATION  LITERAL  -->    identifier 
~>    character   literal 
function  ENUMERATIONLITERAL  r'eturn  boolean  is 
begin 
put(RESULT_FILE,  "In  enumerationliteral  ");  new_line(RESULT_FILE); 

if  (BYPASS(TOKEN_IDENTIFIER))  then 
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return  (TRUE); 
elsif  (BYPASS(TOKEN  CHARACTERLITERAL))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  ENUMERATION  LITERAL; 


--  FORMALPARAMETER  -->    identifier  -> 
function  FORMAL   PARAMETER  return  boolean  is 
begin 

put(RESULT_FILE,  "In  formalparameter  ");  new  Jine(RESULT_FILE); 
LOOKAHEAD  TOKEN  :=  TOKEN  RECORD_BUFFER(TOKENARRAY_INDEX  +  1); 
if  (ADJUST_LEXEME(LOOK   AHEAD  TOKEN. LEXEME, 

LOOKAHEADTOKEN.LEXEMESIZE  -  1)  =  "  =  >")  then 
if  (BYPASS(TOKEN  IDENTIFIER))  then 
if  (BYPASS(TOKEN_ARROW))  then 

return  (TRUE); 
else 

SYNTAX_ERROR("Formal  parameter"); 
end  if;  —  if  bypass(token    arrow) 

else 

SYNTAX_ERROR("Formal  parameter"); 
end  if;  —  if  bypass(token   identifier) 

else 

return  (FALSE); 
end  if; 
end  FORMAL  PARAMETER; 


--  SELECTOR  -->    identifier 

—  >    character   literal 
~>    string   literal 
->    all 
function  SELECTOR  return  boolean  is 
begin 

put(RESULT_FILE,  "In  selector  ");  new_line(RESULT_FILE); 
if  (BYPASS(TOKEN  IDENTIFIER))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_CHARACTER  LITERAL))  then 

return  (TRUE); 
elsif  (BYPASS(TOKEN_STRING_LITERAL))  then 
return  (TRUE); 
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elsif  (BYPASS(TOKEN_ALL))  then 

return  (TRUE); 
else 

return  (FALSE); 
end  if; 
end  SELECTOR; 

end  PARSER  4; 
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